diff options
| author | Andrea Corallo | 2020-03-29 12:31:24 +0100 |
|---|---|---|
| committer | Andrea Corallo | 2020-03-29 12:31:24 +0100 |
| commit | 00ee320a620704ae12a1e2104c2d08bf8bbdf0c9 (patch) | |
| tree | 498c59219b572c89e10f9521b54c98896cb52ca9 | |
| parent | 530faee2752c7b316fa21f2ac4d1266d3e7a38e6 (diff) | |
| parent | 76b3bd8cbb9a0a01941d9c1766c054960e4bfd97 (diff) | |
| download | emacs-00ee320a620704ae12a1e2104c2d08bf8bbdf0c9.tar.gz emacs-00ee320a620704ae12a1e2104c2d08bf8bbdf0c9.zip | |
Merge remote-tracking branch 'savannah/master' into HEAD
66 files changed, 1122 insertions, 886 deletions
diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 768e5051f0b..99469e47aa7 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib | |||
| @@ -31,10 +31,10 @@ GNULIB_MODULES=' | |||
| 31 | careadlinkat close-stream copy-file-range | 31 | careadlinkat close-stream copy-file-range |
| 32 | count-leading-zeros count-one-bits count-trailing-zeros | 32 | count-leading-zeros count-one-bits count-trailing-zeros |
| 33 | crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer | 33 | crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer |
| 34 | d-type diffseq dosname double-slash-root dtoastr dtotimespec dup2 | 34 | d-type diffseq double-slash-root dtoastr dtotimespec dup2 |
| 35 | environ execinfo explicit_bzero faccessat | 35 | environ execinfo explicit_bzero faccessat |
| 36 | fchmodat fcntl fcntl-h fdopendir | 36 | fchmodat fcntl fcntl-h fdopendir |
| 37 | filemode filevercmp flexmember fpieee fstatat fsusage fsync futimens | 37 | filemode filename filevercmp flexmember fpieee fstatat fsusage fsync futimens |
| 38 | getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog | 38 | getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog |
| 39 | ieee754-h ignore-value intprops largefile lstat | 39 | ieee754-h ignore-value intprops largefile lstat |
| 40 | manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime | 40 | manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime |
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 38963f225ca..8a05680c742 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi | |||
| @@ -975,9 +975,27 @@ displays the following frame layout: | |||
| 975 | @end group | 975 | @end group |
| 976 | @end smallexample | 976 | @end smallexample |
| 977 | 977 | ||
| 978 | @findex gdb-save-window-configuration | ||
| 979 | @findex gdb-load-window-configuration | ||
| 980 | @vindex gdb-default-window-configuration-file | ||
| 981 | @vindex gdb-window-configuration-directory | ||
| 982 | You can customize the window layout based on the one above and save | ||
| 983 | that layout to a file using @code{gdb-save-window-configuration}. | ||
| 984 | Then you can later load this layout back using | ||
| 985 | @code{gdb-load-window-configuration}. (Internally, Emacs uses the | ||
| 986 | term window configuration instead of window layout.) You can set your | ||
| 987 | custom layout as the default one used by @code{gdb-many-windows} by | ||
| 988 | customizing @code{gdb-default-window-configuration-file}. If it is | ||
| 989 | not an absolute file name, GDB looks under | ||
| 990 | @code{gdb-window-configuration-directory} for the file. | ||
| 991 | @code{gdb-window-configuration-directory} defaults to | ||
| 992 | @code{user-emacs-directory} (@pxref{Find Init}). | ||
| 993 | |||
| 994 | |||
| 978 | @findex gdb-restore-windows | 995 | @findex gdb-restore-windows |
| 979 | @findex gdb-many-windows | 996 | @findex gdb-many-windows |
| 980 | If you ever change the window layout, you can restore the many-windows | 997 | @vindex gdb-restore-window-configuration-after-quit |
| 998 | If you ever change the window layout, you can restore the default | ||
| 981 | layout by typing @kbd{M-x gdb-restore-windows}. To toggle | 999 | layout by typing @kbd{M-x gdb-restore-windows}. To toggle |
| 982 | between the many windows layout and a simple layout with just the GUD | 1000 | between the many windows layout and a simple layout with just the GUD |
| 983 | interaction buffer and a source file, type @kbd{M-x gdb-many-windows}. | 1001 | interaction buffer and a source file, type @kbd{M-x gdb-many-windows}. |
| @@ -988,7 +1006,13 @@ interaction buffer and a source file, type @kbd{M-x gdb-many-windows}. | |||
| 988 | of windows on your original frame will not be affected. A separate | 1006 | of windows on your original frame will not be affected. A separate |
| 989 | frame for GDB sessions can come in especially handy if you work on a | 1007 | frame for GDB sessions can come in especially handy if you work on a |
| 990 | text-mode terminal, where the screen estate for windows could be at a | 1008 | text-mode terminal, where the screen estate for windows could be at a |
| 991 | premium. | 1009 | premium. If you choose to start GDB in the same frame, consider |
| 1010 | setting @code{gdb-restore-window-configuration-after-quit} to a | ||
| 1011 | non-@code{nil} value. Your original layout will then be restored | ||
| 1012 | after GDB quits. Use @code{t} to always restore; use | ||
| 1013 | @code{if-gdb-many-windows} to restore only when | ||
| 1014 | @code{gdb-many-windows} is non-@code{nil}; use @code{if-gdb-show-main} | ||
| 1015 | to restore only when @code{gdb-show-main} is non-@code{nil}. | ||
| 992 | 1016 | ||
| 993 | You may also specify additional GDB-related buffers to display, | 1017 | You may also specify additional GDB-related buffers to display, |
| 994 | either in the same frame or a different one. Select the buffers you | 1018 | either in the same frame or a different one. Select the buffers you |
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 442f6d156b6..d70c3543f2a 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi | |||
| @@ -2022,6 +2022,20 @@ variable values and buffer content may have been modified in arbitrary | |||
| 2022 | ways. | 2022 | ways. |
| 2023 | @end deftypefn | 2023 | @end deftypefn |
| 2024 | 2024 | ||
| 2025 | @anchor{open_channel} | ||
| 2026 | @deftypefun int open_channel (emacs_env *@var{env}, emacs_value @var{pipe_process}) | ||
| 2027 | This function, which is available since Emacs 28, opens a channel to | ||
| 2028 | an existing pipe process. @var{pipe_process} must refer to an | ||
| 2029 | existing pipe process created by @code{make-pipe-process}. @ref{Pipe | ||
| 2030 | Processes}. If successful, the return value will be a new file | ||
| 2031 | descriptor that you can use to write to the pipe. Unlike all other | ||
| 2032 | module functions, you can use the returned file descriptor from | ||
| 2033 | arbitrary threads, even if no module environment is active. You can | ||
| 2034 | use the @code{write} function to write to the file descriptor. Once | ||
| 2035 | done, close the file descriptor using @code{close}. @ref{Low-Level | ||
| 2036 | I/O,,,libc}. | ||
| 2037 | @end deftypefun | ||
| 2038 | |||
| 2025 | @node Module Nonlocal | 2039 | @node Module Nonlocal |
| 2026 | @subsection Nonlocal Exits in Modules | 2040 | @subsection Nonlocal Exits in Modules |
| 2027 | @cindex nonlocal exits, in modules | 2041 | @cindex nonlocal exits, in modules |
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index f515213615e..14cd079c563 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi | |||
| @@ -743,6 +743,7 @@ Some file name handlers may not support @code{make-process}. In such | |||
| 743 | cases, this function does nothing and returns @code{nil}. | 743 | cases, this function does nothing and returns @code{nil}. |
| 744 | @end defun | 744 | @end defun |
| 745 | 745 | ||
| 746 | @anchor{Pipe Processes} | ||
| 746 | @defun make-pipe-process &rest args | 747 | @defun make-pipe-process &rest args |
| 747 | This function creates a bidirectional pipe which can be attached to a | 748 | This function creates a bidirectional pipe which can be attached to a |
| 748 | child process. This is useful with the @code{:stderr} keyword of | 749 | child process. This is useful with the @code{:stderr} keyword of |
| @@ -38,7 +38,7 @@ when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz | |||
| 38 | text shaping support, and 'ftcr' otherwise. You can determine this by | 38 | text shaping support, and 'ftcr' otherwise. You can determine this by |
| 39 | checking 'system-configuration-features'. The 'ftcr' backend will | 39 | checking 'system-configuration-features'. The 'ftcr' backend will |
| 40 | still be available when HarfBuzz is supported, but will not be used by | 40 | still be available when HarfBuzz is supported, but will not be used by |
| 41 | default. We strongly recommend building with HarBuzz support. 'x' is | 41 | default. We strongly recommend building with HarBuzz support. 'x' is |
| 42 | still a valid backend. | 42 | still a valid backend. |
| 43 | 43 | ||
| 44 | --- | 44 | --- |
| @@ -64,9 +64,9 @@ It was declared obsolete in Emacs 27.1. | |||
| 64 | 64 | ||
| 65 | * Changes in Emacs 28.1 | 65 | * Changes in Emacs 28.1 |
| 66 | 66 | ||
| 67 | ** Support for '(box . SIZE)' cursor-type. | 67 | ** Support for '(box . SIZE)' 'cursor-type'. |
| 68 | By default, 'box' cursor always has a filled box shape. But if you | 68 | By default, 'box' cursor always has a filled box shape. But if you |
| 69 | specify cursor-type to be '(box . SIZE)', the cursor becomes a hollow | 69 | specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow |
| 70 | box if the point is on an image larger than 'SIZE' pixels in any | 70 | box if the point is on an image larger than 'SIZE' pixels in any |
| 71 | dimension. | 71 | dimension. |
| 72 | 72 | ||
| @@ -97,24 +97,33 @@ shows equivalent key bindings for all commands that have them. | |||
| 97 | * Changes in Specialized Modes and Packages in Emacs 28.1 | 97 | * Changes in Specialized Modes and Packages in Emacs 28.1 |
| 98 | 98 | ||
| 99 | ** Emacs-Lisp mode | 99 | ** Emacs-Lisp mode |
| 100 | |||
| 100 | *** The mode-line now indicates whether we're using lexical or dynamic scoping. | 101 | *** The mode-line now indicates whether we're using lexical or dynamic scoping. |
| 101 | 102 | ||
| 102 | ** Dired | 103 | ** Dired |
| 103 | 104 | ||
| 104 | *** New option 'dired-mark-region' affects all Dired commands that mark files. | 105 | *** New user option 'dired-mark-region' affects all Dired commands |
| 105 | When non-nil and the region is active in Transient Mark mode, | 106 | that mark files. When non-nil and the region is active in Transient |
| 106 | then Dired commands operate only on files in the active region. | 107 | Mark mode, then Dired commands operate only on files in the active |
| 107 | The values 'exclusive' and 'inclusive' of this option define | 108 | region. The values 'file' and 'line' of this user option define the |
| 108 | the details of marking the last file at the end of the region. | 109 | details of marking the file at the end of the region. |
| 109 | 110 | ||
| 110 | *** State changing VC operations are supported in dired-mode on files | 111 | *** State changing VC operations are supported in 'dired-mode' on files |
| 111 | (but still not on directories). | 112 | (but still not on directories). |
| 112 | 113 | ||
| 114 | ** Change Logs and VC | ||
| 115 | |||
| 116 | *** New command 'vc-dir-root' uses the root directory without asking. | ||
| 117 | |||
| 113 | ** Gnus | 118 | ** Gnus |
| 114 | 119 | ||
| 115 | --- | 120 | --- |
| 116 | *** Change to default value of 'message-draft-headers' option. | 121 | *** Change to default value of 'message-draft-headers' user option. |
| 117 | No longer includes the Date header. | 122 | The 'Date' symbol has been removed from the default value, meaning that |
| 123 | draft or delayed messages will get a date reflecting when the message | ||
| 124 | was sent. To restore the original behavior of dating a message | ||
| 125 | from when it is first saved or delayed, add the symbol 'Date' back to | ||
| 126 | this user option. | ||
| 118 | 127 | ||
| 119 | ** Help | 128 | ** Help |
| 120 | 129 | ||
| @@ -148,8 +157,8 @@ doc string functions. This makes the results of all doc string | |||
| 148 | functions accessible to the user through the existing single function hook | 157 | functions accessible to the user through the existing single function hook |
| 149 | 'eldoc-documentation-function'. | 158 | 'eldoc-documentation-function'. |
| 150 | 159 | ||
| 151 | *** 'eldoc-documentation-function' is now a custom variable. | 160 | *** 'eldoc-documentation-function' is now a user option. |
| 152 | Modes should use the new hook instead of this variable to register | 161 | Modes should use the new hook instead of this user option to register |
| 153 | their backends. | 162 | their backends. |
| 154 | 163 | ||
| 155 | ** Tramp | 164 | ** Tramp |
| @@ -171,6 +180,7 @@ effect. | |||
| 171 | *** Pcase 'map' pattern added keyword symbols abbreviation. | 180 | *** Pcase 'map' pattern added keyword symbols abbreviation. |
| 172 | A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym', | 181 | A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym', |
| 173 | equivalent to '(map (:sym sym))'. | 182 | equivalent to '(map (:sym sym))'. |
| 183 | |||
| 174 | ** Package | 184 | ** Package |
| 175 | 185 | ||
| 176 | +++ | 186 | +++ |
| @@ -186,17 +196,48 @@ key binding | |||
| 186 | / v package-menu-filter-by-version | 196 | / v package-menu-filter-by-version |
| 187 | / / package-menu-filter-clear | 197 | / / package-menu-filter-clear |
| 188 | 198 | ||
| 199 | ** gdb-mi | ||
| 200 | |||
| 201 | +++ | ||
| 202 | *** gdb-mi can now store and restore window configurations. | ||
| 203 | Use 'gdb-save-window-configuration' to save window configuration to a | ||
| 204 | file and 'gdb-load-window-configuration' to load from a file. These | ||
| 205 | commands can also be accessed through the menu bar under 'Gud -- | ||
| 206 | GDB-Windows'. 'gdb-default-window-configuration-file', when non-nil, | ||
| 207 | is loaded when GDB starts up. | ||
| 208 | |||
| 209 | +++ | ||
| 210 | *** gdb-mi can now restore window configuration after quit. | ||
| 211 | Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs | ||
| 212 | will remember the window configuration before GDB started and restore | ||
| 213 | it after GDB quits. A toggle button is also provided under 'Gud -- | ||
| 214 | GDB-Windows'. | ||
| 215 | |||
| 216 | ** Gravatar | ||
| 217 | |||
| 218 | --- | ||
| 219 | *** New user option 'gravatar-service' for host to query for gravatars. | ||
| 220 | Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options. | ||
| 221 | |||
| 222 | ** Compilation mode | ||
| 223 | |||
| 224 | *** Regexp matching of messages is now case-sensitive by default. | ||
| 225 | The variable 'compilation-error-case-fold-search' can be set for | ||
| 226 | case-insensitive matching of messages when the old behaviour is | ||
| 227 | required, but the recommended solution is to use a correctly matching | ||
| 228 | regexp instead. | ||
| 229 | |||
| 189 | 230 | ||
| 190 | * New Modes and Packages in Emacs 28.1 | 231 | * New Modes and Packages in Emacs 28.1 |
| 191 | 232 | ||
| 192 | 233 | ||
| 193 | * Incompatible Editing Changes in Emacs 28.1 | 234 | * Incompatible Editing Changes in Emacs 28.1 |
| 194 | 235 | ||
| 195 | ** In nroff mode, 'center-line' is now bound to 'M-o M-s'. | 236 | ** In 'nroff-mode', 'center-line' is now bound to 'M-o M-s'. |
| 196 | The original key binding was 'M-s', which interfered with I-search, | 237 | The original key binding was 'M-s', which interfered with I-search, |
| 197 | since the latter uses 'M-s' as a prefix key of the search prefix map. | 238 | since the latter uses 'M-s' as a prefix key of the search prefix map. |
| 198 | 239 | ||
| 199 | ** vc-print-branch-log shows the change log for BRANCH from its root | 240 | ** 'vc-print-branch-log' shows the change log for BRANCH from its root |
| 200 | directory instead of the default directory. | 241 | directory instead of the default directory. |
| 201 | 242 | ||
| 202 | 243 | ||
| @@ -228,7 +269,7 @@ This is no longer supported, and setting this variable has no effect. | |||
| 228 | 269 | ||
| 229 | * Lisp Changes in Emacs 28.1 | 270 | * Lisp Changes in Emacs 28.1 |
| 230 | 271 | ||
| 231 | ** New macro 'dlet' to dynamically bind variables | 272 | ** New macro 'dlet' to dynamically bind variables. |
| 232 | 273 | ||
| 233 | ** The variable 'force-new-style-backquotes' has been removed. | 274 | ** The variable 'force-new-style-backquotes' has been removed. |
| 234 | This removes the final remaining trace of old-style backquotes. | 275 | This removes the final remaining trace of old-style backquotes. |
| @@ -242,6 +283,10 @@ called when the function object is garbage-collected. Use | |||
| 242 | 'set_function_finalizer' to set the finalizer and | 283 | 'set_function_finalizer' to set the finalizer and |
| 243 | 'get_function_finalizer' to retrieve it. | 284 | 'get_function_finalizer' to retrieve it. |
| 244 | 285 | ||
| 286 | ** Modules can now open a channel to an existing pipe process using | ||
| 287 | the new module function 'open_channel'. Modules can use this | ||
| 288 | functionality to asynchronously send data back to Emacs. | ||
| 289 | |||
| 245 | ** 'file-modes', 'set-file-modes', and 'set-file-times' now have an | 290 | ** 'file-modes', 'set-file-modes', and 'set-file-times' now have an |
| 246 | optional argument specifying whether to follow symbolic links. | 291 | optional argument specifying whether to follow symbolic links. |
| 247 | 292 | ||
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 204064f1871..380be95222b 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c | |||
| @@ -80,7 +80,7 @@ char *w32_getenv (const char *); | |||
| 80 | #include <sys/stat.h> | 80 | #include <sys/stat.h> |
| 81 | #include <unistd.h> | 81 | #include <unistd.h> |
| 82 | 82 | ||
| 83 | #include <dosname.h> | 83 | #include <filename.h> |
| 84 | #include <intprops.h> | 84 | #include <intprops.h> |
| 85 | #include <min-max.h> | 85 | #include <min-max.h> |
| 86 | #include <pathmax.h> | 86 | #include <pathmax.h> |
diff --git a/lib/at-func.c b/lib/at-func.c index 4a1c909d38e..90022e05787 100644 --- a/lib/at-func.c +++ b/lib/at-func.c | |||
| @@ -16,7 +16,7 @@ | |||
| 16 | 16 | ||
| 17 | /* written by Jim Meyering */ | 17 | /* written by Jim Meyering */ |
| 18 | 18 | ||
| 19 | #include "dosname.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */ | 19 | #include "filename.h" /* solely for definition of IS_ABSOLUTE_FILE_NAME */ |
| 20 | 20 | ||
| 21 | #ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD | 21 | #ifdef GNULIB_SUPPORT_ONLY_AT_FDCWD |
| 22 | # include <errno.h> | 22 | # include <errno.h> |
diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c index 7d3c710f10f..9f990988393 100644 --- a/lib/canonicalize-lgpl.c +++ b/lib/canonicalize-lgpl.c | |||
| @@ -51,7 +51,7 @@ | |||
| 51 | # define __realpath realpath | 51 | # define __realpath realpath |
| 52 | # include "pathmax.h" | 52 | # include "pathmax.h" |
| 53 | # include "malloca.h" | 53 | # include "malloca.h" |
| 54 | # include "dosname.h" | 54 | # include "filename.h" |
| 55 | # if HAVE_GETCWD | 55 | # if HAVE_GETCWD |
| 56 | # if IN_RELOCWRAPPER | 56 | # if IN_RELOCWRAPPER |
| 57 | /* When building the relocatable program wrapper, use the system's getcwd | 57 | /* When building the relocatable program wrapper, use the system's getcwd |
diff --git a/lib/dosname.h b/lib/dosname.h deleted file mode 100644 index 57829600948..00000000000 --- a/lib/dosname.h +++ /dev/null | |||
| @@ -1,52 +0,0 @@ | |||
| 1 | /* File names on MS-DOS/Windows systems. | ||
| 2 | |||
| 3 | Copyright (C) 2000-2001, 2004-2006, 2009-2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | This program is free software: you can redistribute it and/or modify | ||
| 6 | it under the terms of the GNU General Public License as published by | ||
| 7 | the Free Software Foundation; either version 3 of the License, or | ||
| 8 | (at your option) any later version. | ||
| 9 | |||
| 10 | This program is distributed in the hope that it will be useful, | ||
| 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 13 | GNU General Public License for more details. | ||
| 14 | |||
| 15 | You should have received a copy of the GNU General Public License | ||
| 16 | along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
| 17 | |||
| 18 | From Paul Eggert and Jim Meyering. */ | ||
| 19 | |||
| 20 | #ifndef _DOSNAME_H | ||
| 21 | #define _DOSNAME_H | ||
| 22 | |||
| 23 | #if (defined _WIN32 || defined __CYGWIN__ \ | ||
| 24 | || defined __EMX__ || defined __MSDOS__ || defined __DJGPP__) | ||
| 25 | /* This internal macro assumes ASCII, but all hosts that support drive | ||
| 26 | letters use ASCII. */ | ||
| 27 | # define _IS_DRIVE_LETTER(C) (((unsigned int) (C) | ('a' - 'A')) - 'a' \ | ||
| 28 | <= 'z' - 'a') | ||
| 29 | # define FILE_SYSTEM_PREFIX_LEN(Filename) \ | ||
| 30 | (_IS_DRIVE_LETTER ((Filename)[0]) && (Filename)[1] == ':' ? 2 : 0) | ||
| 31 | # ifndef __CYGWIN__ | ||
| 32 | # define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 1 | ||
| 33 | # endif | ||
| 34 | # define ISSLASH(C) ((C) == '/' || (C) == '\\') | ||
| 35 | #else | ||
| 36 | # define FILE_SYSTEM_PREFIX_LEN(Filename) 0 | ||
| 37 | # define ISSLASH(C) ((C) == '/') | ||
| 38 | #endif | ||
| 39 | |||
| 40 | #ifndef FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE | ||
| 41 | # define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0 | ||
| 42 | #endif | ||
| 43 | |||
| 44 | #if FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE | ||
| 45 | # define IS_ABSOLUTE_FILE_NAME(F) ISSLASH ((F)[FILE_SYSTEM_PREFIX_LEN (F)]) | ||
| 46 | # else | ||
| 47 | # define IS_ABSOLUTE_FILE_NAME(F) \ | ||
| 48 | (ISSLASH ((F)[0]) || FILE_SYSTEM_PREFIX_LEN (F) != 0) | ||
| 49 | #endif | ||
| 50 | #define IS_RELATIVE_FILE_NAME(F) (! IS_ABSOLUTE_FILE_NAME (F)) | ||
| 51 | |||
| 52 | #endif /* DOSNAME_H_ */ | ||
diff --git a/lib/filename.h b/lib/filename.h new file mode 100644 index 00000000000..4598fb1d638 --- /dev/null +++ b/lib/filename.h | |||
| @@ -0,0 +1,110 @@ | |||
| 1 | /* Basic filename support macros. | ||
| 2 | Copyright (C) 2001-2004, 2007-2020 Free Software Foundation, Inc. | ||
| 3 | |||
| 4 | This program is free software: you can redistribute it and/or modify | ||
| 5 | it under the terms of the GNU General Public License as published by | ||
| 6 | the Free Software Foundation; either version 3 of the License, or | ||
| 7 | (at your option) any later version. | ||
| 8 | |||
| 9 | This program 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 General Public License for more details. | ||
| 13 | |||
| 14 | You should have received a copy of the GNU General Public License | ||
| 15 | along with this program. If not, see <https://www.gnu.org/licenses/>. */ | ||
| 16 | |||
| 17 | /* From Paul Eggert and Jim Meyering. */ | ||
| 18 | |||
| 19 | #ifndef _FILENAME_H | ||
| 20 | #define _FILENAME_H | ||
| 21 | |||
| 22 | #include <string.h> | ||
| 23 | |||
| 24 | #ifdef __cplusplus | ||
| 25 | extern "C" { | ||
| 26 | #endif | ||
| 27 | |||
| 28 | |||
| 29 | /* Filename support. | ||
| 30 | ISSLASH(C) tests whether C is a directory separator | ||
| 31 | character. | ||
| 32 | HAS_DEVICE(Filename) tests whether Filename contains a device | ||
| 33 | specification. | ||
| 34 | FILE_SYSTEM_PREFIX_LEN(Filename) length of the device specification | ||
| 35 | at the beginning of Filename, | ||
| 36 | index of the part consisting of | ||
| 37 | alternating components and slashes. | ||
| 38 | FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE | ||
| 39 | 1 when a non-empty device specification | ||
| 40 | can be followed by an empty or relative | ||
| 41 | part, | ||
| 42 | 0 when a non-empty device specification | ||
| 43 | must be followed by a slash, | ||
| 44 | 0 when device specification don't exist. | ||
| 45 | IS_ABSOLUTE_FILE_NAME(Filename) | ||
| 46 | tests whether Filename is independent of | ||
| 47 | any notion of "current directory". | ||
| 48 | IS_RELATIVE_FILE_NAME(Filename) | ||
| 49 | tests whether Filename may be concatenated | ||
| 50 | to a directory filename. | ||
| 51 | Note: On native Windows, OS/2, DOS, "c:" is neither an absolute nor a | ||
| 52 | relative file name! | ||
| 53 | IS_FILE_NAME_WITH_DIR(Filename) tests whether Filename contains a device | ||
| 54 | or directory specification. | ||
| 55 | */ | ||
| 56 | #if defined _WIN32 || defined __CYGWIN__ \ | ||
| 57 | || defined __EMX__ || defined __MSDOS__ || defined __DJGPP__ | ||
| 58 | /* Native Windows, Cygwin, OS/2, DOS */ | ||
| 59 | # define ISSLASH(C) ((C) == '/' || (C) == '\\') | ||
| 60 | /* Internal macro: Tests whether a character is a drive letter. */ | ||
| 61 | # define _IS_DRIVE_LETTER(C) \ | ||
| 62 | (((C) >= 'A' && (C) <= 'Z') || ((C) >= 'a' && (C) <= 'z')) | ||
| 63 | /* Help the compiler optimizing it. This assumes ASCII. */ | ||
| 64 | # undef _IS_DRIVE_LETTER | ||
| 65 | # define _IS_DRIVE_LETTER(C) \ | ||
| 66 | (((unsigned int) (C) | ('a' - 'A')) - 'a' <= 'z' - 'a') | ||
| 67 | # define HAS_DEVICE(Filename) \ | ||
| 68 | (_IS_DRIVE_LETTER ((Filename)[0]) && (Filename)[1] == ':') | ||
| 69 | # define FILE_SYSTEM_PREFIX_LEN(Filename) (HAS_DEVICE (Filename) ? 2 : 0) | ||
| 70 | # ifdef __CYGWIN__ | ||
| 71 | # define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0 | ||
| 72 | # else | ||
| 73 | /* On native Windows, OS/2, DOS, the system has the notion of a | ||
| 74 | "current directory" on each drive. */ | ||
| 75 | # define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 1 | ||
| 76 | # endif | ||
| 77 | # if FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE | ||
| 78 | # define IS_ABSOLUTE_FILE_NAME(Filename) \ | ||
| 79 | ISSLASH ((Filename)[FILE_SYSTEM_PREFIX_LEN (Filename)]) | ||
| 80 | # else | ||
| 81 | # define IS_ABSOLUTE_FILE_NAME(Filename) \ | ||
| 82 | (ISSLASH ((Filename)[0]) || HAS_DEVICE (Filename)) | ||
| 83 | # endif | ||
| 84 | # define IS_RELATIVE_FILE_NAME(Filename) \ | ||
| 85 | (! (ISSLASH ((Filename)[0]) || HAS_DEVICE (Filename))) | ||
| 86 | # define IS_FILE_NAME_WITH_DIR(Filename) \ | ||
| 87 | (strchr ((Filename), '/') != NULL || strchr ((Filename), '\\') != NULL \ | ||
| 88 | || HAS_DEVICE (Filename)) | ||
| 89 | #else | ||
| 90 | /* Unix */ | ||
| 91 | # define ISSLASH(C) ((C) == '/') | ||
| 92 | # define HAS_DEVICE(Filename) ((void) (Filename), 0) | ||
| 93 | # define FILE_SYSTEM_PREFIX_LEN(Filename) ((void) (Filename), 0) | ||
| 94 | # define FILE_SYSTEM_DRIVE_PREFIX_CAN_BE_RELATIVE 0 | ||
| 95 | # define IS_ABSOLUTE_FILE_NAME(Filename) ISSLASH ((Filename)[0]) | ||
| 96 | # define IS_RELATIVE_FILE_NAME(Filename) (! ISSLASH ((Filename)[0])) | ||
| 97 | # define IS_FILE_NAME_WITH_DIR(Filename) (strchr ((Filename), '/') != NULL) | ||
| 98 | #endif | ||
| 99 | |||
| 100 | /* Deprecated macros. For backward compatibility with old users of the | ||
| 101 | 'filename' module. */ | ||
| 102 | #define IS_ABSOLUTE_PATH IS_ABSOLUTE_FILE_NAME | ||
| 103 | #define IS_PATH_WITH_DIR IS_FILE_NAME_WITH_DIR | ||
| 104 | |||
| 105 | |||
| 106 | #ifdef __cplusplus | ||
| 107 | } | ||
| 108 | #endif | ||
| 109 | |||
| 110 | #endif /* _FILENAME_H */ | ||
diff --git a/lib/getopt-pfx-core.h b/lib/getopt-pfx-core.h index da0a6d0c3c4..ec545c1b51c 100644 --- a/lib/getopt-pfx-core.h +++ b/lib/getopt-pfx-core.h | |||
| @@ -48,6 +48,14 @@ | |||
| 48 | # define optind __GETOPT_ID (optind) | 48 | # define optind __GETOPT_ID (optind) |
| 49 | # define optopt __GETOPT_ID (optopt) | 49 | # define optopt __GETOPT_ID (optopt) |
| 50 | 50 | ||
| 51 | /* Work around a a problem on macOS, which declares getopt with a | ||
| 52 | trailing __DARWIN_ALIAS(getopt) that would expand to something like | ||
| 53 | __asm("_" "rpl_getopt" "$UNIX2003") were it not for the following | ||
| 54 | hack to suppress the macOS declaration <https://bugs.gnu.org/40205>. */ | ||
| 55 | # ifdef __APPLE__ | ||
| 56 | # define _GETOPT | ||
| 57 | # endif | ||
| 58 | |||
| 51 | /* The system's getopt.h may have already included getopt-core.h to | 59 | /* The system's getopt.h may have already included getopt-core.h to |
| 52 | declare the unprefixed identifiers. Undef _GETOPT_CORE_H so that | 60 | declare the unprefixed identifiers. Undef _GETOPT_CORE_H so that |
| 53 | getopt-core.h declares them with prefixes. */ | 61 | getopt-core.h declares them with prefixes. */ |
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index e90d2e39049..0c7c2fb2b66 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in | |||
| @@ -86,7 +86,6 @@ | |||
| 86 | # crypto/sha512-buffer \ | 86 | # crypto/sha512-buffer \ |
| 87 | # d-type \ | 87 | # d-type \ |
| 88 | # diffseq \ | 88 | # diffseq \ |
| 89 | # dosname \ | ||
| 90 | # double-slash-root \ | 89 | # double-slash-root \ |
| 91 | # dtoastr \ | 90 | # dtoastr \ |
| 92 | # dtotimespec \ | 91 | # dtotimespec \ |
| @@ -100,6 +99,7 @@ | |||
| 100 | # fcntl-h \ | 99 | # fcntl-h \ |
| 101 | # fdopendir \ | 100 | # fdopendir \ |
| 102 | # filemode \ | 101 | # filemode \ |
| 102 | # filename \ | ||
| 103 | # filevercmp \ | 103 | # filevercmp \ |
| 104 | # flexmember \ | 104 | # flexmember \ |
| 105 | # fpieee \ | 105 | # fpieee \ |
| @@ -1452,15 +1452,6 @@ EXTRA_libgnu_a_SOURCES += dirfd.c | |||
| 1452 | endif | 1452 | endif |
| 1453 | ## end gnulib module dirfd | 1453 | ## end gnulib module dirfd |
| 1454 | 1454 | ||
| 1455 | ## begin gnulib module dosname | ||
| 1456 | ifeq (,$(OMIT_GNULIB_MODULE_dosname)) | ||
| 1457 | |||
| 1458 | |||
| 1459 | EXTRA_DIST += dosname.h | ||
| 1460 | |||
| 1461 | endif | ||
| 1462 | ## end gnulib module dosname | ||
| 1463 | |||
| 1464 | ## begin gnulib module dtoastr | 1455 | ## begin gnulib module dtoastr |
| 1465 | ifeq (,$(OMIT_GNULIB_MODULE_dtoastr)) | 1456 | ifeq (,$(OMIT_GNULIB_MODULE_dtoastr)) |
| 1466 | 1457 | ||
| @@ -1672,6 +1663,15 @@ EXTRA_DIST += filemode.h | |||
| 1672 | endif | 1663 | endif |
| 1673 | ## end gnulib module filemode | 1664 | ## end gnulib module filemode |
| 1674 | 1665 | ||
| 1666 | ## begin gnulib module filename | ||
| 1667 | ifeq (,$(OMIT_GNULIB_MODULE_filename)) | ||
| 1668 | |||
| 1669 | |||
| 1670 | EXTRA_DIST += filename.h | ||
| 1671 | |||
| 1672 | endif | ||
| 1673 | ## end gnulib module filename | ||
| 1674 | |||
| 1675 | ## begin gnulib module filevercmp | 1675 | ## begin gnulib module filevercmp |
| 1676 | ifeq (,$(OMIT_GNULIB_MODULE_filevercmp)) | 1676 | ifeq (,$(OMIT_GNULIB_MODULE_filevercmp)) |
| 1677 | 1677 | ||
diff --git a/lisp/char-fold.el b/lisp/char-fold.el index f8a303956e3..5a3c20c7832 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el | |||
| @@ -370,11 +370,7 @@ from which to start." | |||
| 370 | (setq i (1+ i))) | 370 | (setq i (1+ i))) |
| 371 | (when (> spaces 0) | 371 | (when (> spaces 0) |
| 372 | (push (char-fold--make-space-string spaces) out)) | 372 | (push (char-fold--make-space-string spaces) out)) |
| 373 | (let ((regexp (apply #'concat (nreverse out)))) | 373 | (apply #'concat (nreverse out)))) |
| 374 | ;; Limited by `MAX_BUF_SIZE' in `regex-emacs.c'. | ||
| 375 | (if (> (length regexp) 5000) | ||
| 376 | (regexp-quote string) | ||
| 377 | regexp)))) | ||
| 378 | 374 | ||
| 379 | 375 | ||
| 380 | ;;; Commands provided for completeness. | 376 | ;;; Commands provided for completeness. |
diff --git a/lisp/dired.el b/lisp/dired.el index 438f5e7d8b4..41bbf9f56a2 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -296,7 +296,7 @@ new Dired buffers." | |||
| 296 | :version "26.1" | 296 | :version "26.1" |
| 297 | :group 'dired) | 297 | :group 'dired) |
| 298 | 298 | ||
| 299 | (defcustom dired-mark-region 'exclusive | 299 | (defcustom dired-mark-region 'file |
| 300 | "Defines what commands that mark files do with the active region. | 300 | "Defines what commands that mark files do with the active region. |
| 301 | 301 | ||
| 302 | When nil, marking commands don't operate on all files in the | 302 | When nil, marking commands don't operate on all files in the |
| @@ -306,7 +306,8 @@ When the value of this option is non-nil, then all Dired commands | |||
| 306 | that mark or unmark files will operate on all files in the region | 306 | that mark or unmark files will operate on all files in the region |
| 307 | if the region is active in Transient Mark mode. | 307 | if the region is active in Transient Mark mode. |
| 308 | 308 | ||
| 309 | When `exclusive', don't mark the file if the end of the region is | 309 | When `file', the region marking is based on the file name. |
| 310 | This means don't mark the file if the end of the region is | ||
| 310 | before the file name displayed on the Dired line, so the file name | 311 | before the file name displayed on the Dired line, so the file name |
| 311 | is visually outside the region. This behavior is consistent with | 312 | is visually outside the region. This behavior is consistent with |
| 312 | marking files without the region using the key `m' that advances | 313 | marking files without the region using the key `m' that advances |
| @@ -315,12 +316,13 @@ of keys used to mark files is the same as the number of keys | |||
| 315 | used to select the region, e.g. `M-2 m' marks 2 files, and | 316 | used to select the region, e.g. `M-2 m' marks 2 files, and |
| 316 | `C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files. | 317 | `C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files. |
| 317 | 318 | ||
| 318 | When `inclusive', include the file into marking if the end of the region | 319 | When `line', the region marking is based on Dired lines, |
| 320 | so include the file into marking if the end of the region | ||
| 319 | is anywhere on its Dired line, except the beginning of the line." | 321 | is anywhere on its Dired line, except the beginning of the line." |
| 320 | :type '(choice | 322 | :type '(choice |
| 321 | (const :tag "Don't mark files in active region" nil) | 323 | (const :tag "Don't mark files in active region" nil) |
| 322 | (const :tag "Exclude file name outside of region" exclusive) | 324 | (const :tag "Exclude file name outside of region" file) |
| 323 | (const :tag "Include the file at region end line" inclusive)) | 325 | (const :tag "Include the file at region end line" line)) |
| 324 | :group 'dired | 326 | :group 'dired |
| 325 | :version "28.1") | 327 | :version "28.1") |
| 326 | 328 | ||
| @@ -646,16 +648,19 @@ of the region if `dired-mark-region' is non-nil. Otherwise, operate | |||
| 646 | on the whole buffer. | 648 | on the whole buffer. |
| 647 | 649 | ||
| 648 | Return value is the number of files marked, or nil if none were marked." | 650 | Return value is the number of files marked, or nil if none were marked." |
| 649 | `(let ((inhibit-read-only t) count | 651 | `(let* ((inhibit-read-only t) count |
| 650 | (beg (if (and dired-mark-region (use-region-p)) | 652 | (use-region-p (and dired-mark-region |
| 653 | (region-active-p) | ||
| 654 | (> (region-end) (region-beginning)))) | ||
| 655 | (beg (if use-region-p | ||
| 651 | (save-excursion | 656 | (save-excursion |
| 652 | (goto-char (region-beginning)) | 657 | (goto-char (region-beginning)) |
| 653 | (line-beginning-position)) | 658 | (line-beginning-position)) |
| 654 | (point-min))) | 659 | (point-min))) |
| 655 | (end (if (and dired-mark-region (use-region-p)) | 660 | (end (if use-region-p |
| 656 | (save-excursion | 661 | (save-excursion |
| 657 | (goto-char (region-end)) | 662 | (goto-char (region-end)) |
| 658 | (if (if (eq dired-mark-region 'inclusive) | 663 | (if (if (eq dired-mark-region 'line) |
| 659 | (not (bolp)) | 664 | (not (bolp)) |
| 660 | (get-text-property (1- (point)) 'dired-filename)) | 665 | (get-text-property (1- (point)) 'dired-filename)) |
| 661 | (line-end-position) | 666 | (line-end-position) |
| @@ -673,7 +678,7 @@ Return value is the number of files marked, or nil if none were marked." | |||
| 673 | (if (eq dired-del-marker dired-marker-char) | 678 | (if (eq dired-del-marker dired-marker-char) |
| 674 | " for deletion" | 679 | " for deletion" |
| 675 | "") | 680 | "") |
| 676 | (if (and dired-mark-region (use-region-p)) | 681 | (if use-region-p |
| 677 | " in region" | 682 | " in region" |
| 678 | ""))) | 683 | ""))) |
| 679 | (goto-char beg) | 684 | (goto-char beg) |
| @@ -691,7 +696,7 @@ Return value is the number of files marked, or nil if none were marked." | |||
| 691 | (if (eq dired-marker-char ?\s) "un" "") | 696 | (if (eq dired-marker-char ?\s) "un" "") |
| 692 | (if (eq dired-marker-char dired-del-marker) | 697 | (if (eq dired-marker-char dired-del-marker) |
| 693 | "flagged" "marked") | 698 | "flagged" "marked") |
| 694 | (if (and dired-mark-region (use-region-p)) | 699 | (if use-region-p |
| 695 | " in region" | 700 | " in region" |
| 696 | "")))) | 701 | "")))) |
| 697 | (and (> count 0) count))) | 702 | (and (> count 0) count))) |
| @@ -3645,14 +3650,16 @@ this subdir." | |||
| 3645 | (interactive (list current-prefix-arg t)) | 3650 | (interactive (list current-prefix-arg t)) |
| 3646 | (cond | 3651 | (cond |
| 3647 | ;; Mark files in the active region. | 3652 | ;; Mark files in the active region. |
| 3648 | ((and dired-mark-region interactive (use-region-p)) | 3653 | ((and interactive dired-mark-region |
| 3654 | (region-active-p) | ||
| 3655 | (> (region-end) (region-beginning))) | ||
| 3649 | (save-excursion | 3656 | (save-excursion |
| 3650 | (let ((beg (region-beginning)) | 3657 | (let ((beg (region-beginning)) |
| 3651 | (end (region-end))) | 3658 | (end (region-end))) |
| 3652 | (dired-mark-files-in-region | 3659 | (dired-mark-files-in-region |
| 3653 | (progn (goto-char beg) (line-beginning-position)) | 3660 | (progn (goto-char beg) (line-beginning-position)) |
| 3654 | (progn (goto-char end) | 3661 | (progn (goto-char end) |
| 3655 | (if (if (eq dired-mark-region 'inclusive) | 3662 | (if (if (eq dired-mark-region 'line) |
| 3656 | (not (bolp)) | 3663 | (not (bolp)) |
| 3657 | (get-text-property (1- (point)) 'dired-filename)) | 3664 | (get-text-property (1- (point)) 'dired-filename)) |
| 3658 | (line-end-position) | 3665 | (line-end-position) |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 954731b06b8..7f5d197b532 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -2868,7 +2868,9 @@ Supported keywords for slots are: | |||
| 2868 | (append pred-form '(t)) | 2868 | (append pred-form '(t)) |
| 2869 | `(and ,pred-form t))) | 2869 | `(and ,pred-form t))) |
| 2870 | forms) | 2870 | forms) |
| 2871 | (push `(put ',name 'cl-deftype-satisfies ',predicate) forms)) | 2871 | (push `(eval-and-compile |
| 2872 | (put ',name 'cl-deftype-satisfies ',predicate)) | ||
| 2873 | forms)) | ||
| 2872 | (let ((pos 0) (descp descs)) | 2874 | (let ((pos 0) (descp descs)) |
| 2873 | (while descp | 2875 | (while descp |
| 2874 | (let* ((desc (pop descp)) | 2876 | (let* ((desc (pop descp)) |
| @@ -3138,6 +3140,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." | |||
| 3138 | ;; "Obvious" mappings. | 3140 | ;; "Obvious" mappings. |
| 3139 | (string . stringp) | 3141 | (string . stringp) |
| 3140 | (list . listp) | 3142 | (list . listp) |
| 3143 | (cons . consp) | ||
| 3141 | (symbol . symbolp) | 3144 | (symbol . symbolp) |
| 3142 | (function . functionp) | 3145 | (function . functionp) |
| 3143 | (integer . integerp) | 3146 | (integer . integerp) |
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 4fa31f32673..4cebd739c3b 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el | |||
| @@ -52,7 +52,7 @@ | |||
| 52 | (let ((repeat (aref timer 4))) | 52 | (let ((repeat (aref timer 4))) |
| 53 | (cond | 53 | (cond |
| 54 | ((numberp repeat) | 54 | ((numberp repeat) |
| 55 | (format "%.2f" (/ repeat 60))) | 55 | (format "%.1f" repeat)) |
| 56 | ((null repeat) | 56 | ((null repeat) |
| 57 | "-") | 57 | "-") |
| 58 | (t | 58 | (t |
| @@ -91,7 +91,18 @@ | |||
| 91 | (setq header-line-format | 91 | (setq header-line-format |
| 92 | (concat (propertize " " 'display '(space :align-to 0)) | 92 | (concat (propertize " " 'display '(space :align-to 0)) |
| 93 | (format "%4s %10s %8s %s" | 93 | (format "%4s %10s %8s %s" |
| 94 | "Idle" "Next" "Repeat" "Function")))) | 94 | (propertize "Idle" |
| 95 | 'mouse-face 'highlight | ||
| 96 | 'help-echo "* marks idle timers") | ||
| 97 | (propertize "Next" | ||
| 98 | 'mouse-face 'highlight | ||
| 99 | 'help-echo "Time in sec till next invocation") | ||
| 100 | (propertize "Repeat" | ||
| 101 | 'mouse-face 'highlight | ||
| 102 | 'help-echo "Symbol: repeat; number: repeat interval in sec") | ||
| 103 | (propertize "Function" | ||
| 104 | 'mouse-face 'highlight | ||
| 105 | 'help-echo "Function called by timer"))))) | ||
| 95 | 106 | ||
| 96 | (defun timer-list-cancel () | 107 | (defun timer-list-cancel () |
| 97 | "Cancel the timer on the line under point." | 108 | "Cancel the timer on the line under point." |
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index fd2b44f7424..480ed80ef81 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; gnus-registry.el --- article registry for Gnus | 1 | ;;; gnus-registry.el --- article registry for Gnus -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -62,10 +62,10 @@ | |||
| 62 | 62 | ||
| 63 | ;; show the marks as single characters (see the :char property in | 63 | ;; show the marks as single characters (see the :char property in |
| 64 | ;; `gnus-registry-marks'): | 64 | ;; `gnus-registry-marks'): |
| 65 | ;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) | 65 | ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars) |
| 66 | 66 | ||
| 67 | ;; show the marks by name (see `gnus-registry-marks'): | 67 | ;; show the marks by name (see `gnus-registry-marks'): |
| 68 | ;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names) | 68 | ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names) |
| 69 | 69 | ||
| 70 | ;; TODO: | 70 | ;; TODO: |
| 71 | 71 | ||
| @@ -588,7 +588,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 588 | subject | 588 | subject |
| 589 | (< gnus-registry-minimum-subject-length (length subject))) | 589 | (< gnus-registry-minimum-subject-length (length subject))) |
| 590 | (let ((groups (apply | 590 | (let ((groups (apply |
| 591 | 'append | 591 | #'append |
| 592 | (mapcar | 592 | (mapcar |
| 593 | (lambda (reference) | 593 | (lambda (reference) |
| 594 | (gnus-registry-get-id-key reference 'group)) | 594 | (gnus-registry-get-id-key reference 'group)) |
| @@ -615,7 +615,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 615 | sender | 615 | sender |
| 616 | gnus-registry-unfollowed-addresses))) | 616 | gnus-registry-unfollowed-addresses))) |
| 617 | (let ((groups (apply | 617 | (let ((groups (apply |
| 618 | 'append | 618 | #'append |
| 619 | (mapcar | 619 | (mapcar |
| 620 | (lambda (reference) | 620 | (lambda (reference) |
| 621 | (gnus-registry-get-id-key reference 'group)) | 621 | (gnus-registry-get-id-key reference 'group)) |
| @@ -644,7 +644,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 644 | (not (gnus-grep-in-list | 644 | (not (gnus-grep-in-list |
| 645 | recp | 645 | recp |
| 646 | gnus-registry-unfollowed-addresses))) | 646 | gnus-registry-unfollowed-addresses))) |
| 647 | (let ((groups (apply 'append | 647 | (let ((groups (apply #'append |
| 648 | (mapcar | 648 | (mapcar |
| 649 | (lambda (reference) | 649 | (lambda (reference) |
| 650 | (gnus-registry-get-id-key reference 'group)) | 650 | (gnus-registry-get-id-key reference 'group)) |
| @@ -663,7 +663,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." | |||
| 663 | ;; filter the found groups and return them | 663 | ;; filter the found groups and return them |
| 664 | ;; the found groups are NOT the full groups | 664 | ;; the found groups are NOT the full groups |
| 665 | (setq found (gnus-registry-post-process-groups | 665 | (setq found (gnus-registry-post-process-groups |
| 666 | "recipients" (mapconcat 'identity recipients ", ") found))) | 666 | "recipients" (mapconcat #'identity recipients ", ") found))) |
| 667 | 667 | ||
| 668 | ;; after the (cond) we extract the actual value safely | 668 | ;; after the (cond) we extract the actual value safely |
| 669 | (car-safe found))) | 669 | (car-safe found))) |
| @@ -791,7 +791,8 @@ Consults `gnus-registry-ignored-groups' and | |||
| 791 | ((stringp g) g) | 791 | ((stringp g) g) |
| 792 | ((and (listp g) (nth 1 g)) | 792 | ((and (listp g) (nth 1 g)) |
| 793 | (nth 0 g)) | 793 | (nth 0 g)) |
| 794 | (t nil))) gnus-registry-ignored-groups))) | 794 | (t nil))) |
| 795 | gnus-registry-ignored-groups))) | ||
| 795 | ;; only use `gnus-parameter-registry-ignore' if | 796 | ;; only use `gnus-parameter-registry-ignore' if |
| 796 | ;; `gnus-registry-ignored-groups' is a list of lists | 797 | ;; `gnus-registry-ignored-groups' is a list of lists |
| 797 | ;; (it can be a list of regexes) | 798 | ;; (it can be a list of regexes) |
| @@ -871,7 +872,7 @@ Addresses without a name will say \"noname\"." | |||
| 871 | 872 | ||
| 872 | (defun gnus-registry-sort-addresses (&rest addresses) | 873 | (defun gnus-registry-sort-addresses (&rest addresses) |
| 873 | "Return a normalized and sorted list of ADDRESSES." | 874 | "Return a normalized and sorted list of ADDRESSES." |
| 874 | (sort (mapcan 'gnus-registry-extract-addresses addresses) 'string-lessp)) | 875 | (sort (mapcan #'gnus-registry-extract-addresses addresses) 'string-lessp)) |
| 875 | 876 | ||
| 876 | (defun gnus-registry-simplify-subject (subject) | 877 | (defun gnus-registry-simplify-subject (subject) |
| 877 | (if (stringp subject) | 878 | (if (stringp subject) |
| @@ -961,16 +962,15 @@ Uses `gnus-registry-marks' to find what shortcuts to install." | |||
| 961 | (intern (format function-format variant-name))) | 962 | (intern (format function-format variant-name))) |
| 962 | (shortcut (format "%c" (if remove (upcase data) data)))) | 963 | (shortcut (format "%c" (if remove (upcase data) data)))) |
| 963 | (defalias function-name | 964 | (defalias function-name |
| 964 | ;; If it weren't for the function's docstring, we could | 965 | (lambda (&rest articles) |
| 965 | ;; use a closure, with lexical-let :-( | 966 | (:documentation |
| 966 | `(lambda (&rest articles) | 967 | (format |
| 967 | ,(format | 968 | "%s the %s mark over process-marked ARTICLES." |
| 968 | "%s the %s mark over process-marked ARTICLES." | 969 | (upcase-initials variant-name) |
| 969 | (upcase-initials variant-name) | 970 | mark)) |
| 970 | mark) | 971 | (interactive |
| 971 | (interactive | 972 | (gnus-summary-work-articles current-prefix-arg)) |
| 972 | (gnus-summary-work-articles current-prefix-arg)) | 973 | (gnus-registry--set/remove-mark mark remove articles))) |
| 973 | (gnus-registry--set/remove-mark ',mark ',remove articles))) | ||
| 974 | (push function-name keys-plist) | 974 | (push function-name keys-plist) |
| 975 | (push shortcut keys-plist) | 975 | (push shortcut keys-plist) |
| 976 | (push (vector (format "%s %s" | 976 | (push (vector (format "%s %s" |
| @@ -990,14 +990,11 @@ Uses `gnus-registry-marks' to find what shortcuts to install." | |||
| 990 | nil | 990 | nil |
| 991 | (cons "Registry Marks" gnus-registry-misc-menus)))))) | 991 | (cons "Registry Marks" gnus-registry-misc-menus)))))) |
| 992 | 992 | ||
| 993 | (make-obsolete 'gnus-registry-user-format-function-M | 993 | (define-obsolete-function-alias 'gnus-registry-user-format-function-M |
| 994 | 'gnus-registry-article-marks-to-chars "24.1") ? | 994 | #'gnus-registry-article-marks-to-chars "24.1") |
| 995 | |||
| 996 | (defalias 'gnus-registry-user-format-function-M | ||
| 997 | 'gnus-registry-article-marks-to-chars) | ||
| 998 | 995 | ||
| 999 | ;; use like this: | 996 | ;; use like this: |
| 1000 | ;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) | 997 | ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars) |
| 1001 | (defun gnus-registry-article-marks-to-chars (headers) | 998 | (defun gnus-registry-article-marks-to-chars (headers) |
| 1002 | "Show the marks for an article by the :char property." | 999 | "Show the marks for an article by the :char property." |
| 1003 | (if gnus-registry-enabled | 1000 | (if gnus-registry-enabled |
| @@ -1013,20 +1010,20 @@ Uses `gnus-registry-marks' to find what shortcuts to install." | |||
| 1013 | "")) | 1010 | "")) |
| 1014 | 1011 | ||
| 1015 | ;; use like this: | 1012 | ;; use like this: |
| 1016 | ;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names) | 1013 | ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names) |
| 1017 | (defun gnus-registry-article-marks-to-names (headers) | 1014 | (defun gnus-registry-article-marks-to-names (headers) |
| 1018 | "Show the marks for an article by name." | 1015 | "Show the marks for an article by name." |
| 1019 | (if gnus-registry-enabled | 1016 | (if gnus-registry-enabled |
| 1020 | (let* ((id (mail-header-message-id headers)) | 1017 | (let* ((id (mail-header-message-id headers)) |
| 1021 | (marks (when id (gnus-registry-get-id-key id 'mark)))) | 1018 | (marks (when id (gnus-registry-get-id-key id 'mark)))) |
| 1022 | (mapconcat (lambda (mark) (symbol-name mark)) marks ",")) | 1019 | (mapconcat #'symbol-name marks ",")) |
| 1023 | "")) | 1020 | "")) |
| 1024 | 1021 | ||
| 1025 | (defun gnus-registry-read-mark () | 1022 | (defun gnus-registry-read-mark () |
| 1026 | "Read a mark name from the user with completion." | 1023 | "Read a mark name from the user with completion." |
| 1027 | (let ((mark (gnus-completing-read | 1024 | (let ((mark (gnus-completing-read |
| 1028 | "Label" | 1025 | "Label" |
| 1029 | (mapcar 'symbol-name (mapcar 'car gnus-registry-marks)) | 1026 | (mapcar #'symbol-name (mapcar #'car gnus-registry-marks)) |
| 1030 | nil nil nil | 1027 | nil nil nil |
| 1031 | (symbol-name gnus-registry-default-mark)))) | 1028 | (symbol-name gnus-registry-default-mark)))) |
| 1032 | (when (stringp mark) | 1029 | (when (stringp mark) |
| @@ -1050,7 +1047,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install." | |||
| 1050 | show-message) | 1047 | show-message) |
| 1051 | "Apply or remove MARK across a list of ARTICLES." | 1048 | "Apply or remove MARK across a list of ARTICLES." |
| 1052 | (let ((article-id-list | 1049 | (let ((article-id-list |
| 1053 | (mapcar 'gnus-registry-fetch-message-id-fast articles))) | 1050 | (mapcar #'gnus-registry-fetch-message-id-fast articles))) |
| 1054 | (dolist (id article-id-list) | 1051 | (dolist (id article-id-list) |
| 1055 | (let* ((marks (delq mark (gnus-registry-get-id-key id 'mark))) | 1052 | (let* ((marks (delq mark (gnus-registry-get-id-key id 'mark))) |
| 1056 | (marks (if remove marks (cons mark marks)))) | 1053 | (marks (if remove marks (cons mark marks)))) |
| @@ -1173,34 +1170,34 @@ only the last one's marks are returned." | |||
| 1173 | (gnus-registry-install-shortcuts) | 1170 | (gnus-registry-install-shortcuts) |
| 1174 | (if (gnus-alive-p) | 1171 | (if (gnus-alive-p) |
| 1175 | (gnus-registry-load) | 1172 | (gnus-registry-load) |
| 1176 | (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load))) | 1173 | (add-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load))) |
| 1177 | 1174 | ||
| 1178 | (defun gnus-registry-install-hooks () | 1175 | (defun gnus-registry-install-hooks () |
| 1179 | "Install the registry hooks." | 1176 | "Install the registry hooks." |
| 1180 | (setq gnus-registry-enabled t) | 1177 | (setq gnus-registry-enabled t) |
| 1181 | (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action) | 1178 | (add-hook 'gnus-summary-article-move-hook #'gnus-registry-action) |
| 1182 | (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) | 1179 | (add-hook 'gnus-summary-article-delete-hook #'gnus-registry-action) |
| 1183 | (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) | 1180 | (add-hook 'gnus-summary-article-expire-hook #'gnus-registry-action) |
| 1184 | (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action) | 1181 | (add-hook 'nnmail-spool-hook #'gnus-registry-spool-action) |
| 1185 | 1182 | ||
| 1186 | (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save) | 1183 | (add-hook 'gnus-save-newsrc-hook #'gnus-registry-save) |
| 1187 | 1184 | ||
| 1188 | (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) | 1185 | (add-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)) |
| 1189 | 1186 | ||
| 1190 | (defun gnus-registry-unload-hook () | 1187 | (defun gnus-registry-unload-hook () |
| 1191 | "Uninstall the registry hooks." | 1188 | "Uninstall the registry hooks." |
| 1192 | (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action) | 1189 | (remove-hook 'gnus-summary-article-move-hook #'gnus-registry-action) |
| 1193 | (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) | 1190 | (remove-hook 'gnus-summary-article-delete-hook #'gnus-registry-action) |
| 1194 | (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) | 1191 | (remove-hook 'gnus-summary-article-expire-hook #'gnus-registry-action) |
| 1195 | (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action) | 1192 | (remove-hook 'nnmail-spool-hook #'gnus-registry-spool-action) |
| 1196 | 1193 | ||
| 1197 | (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save) | 1194 | (remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save) |
| 1198 | (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load) | 1195 | (remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load) |
| 1199 | 1196 | ||
| 1200 | (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids) | 1197 | (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids) |
| 1201 | (setq gnus-registry-enabled nil)) | 1198 | (setq gnus-registry-enabled nil)) |
| 1202 | 1199 | ||
| 1203 | (add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook) | 1200 | (add-hook 'gnus-registry-unload-hook #'gnus-registry-unload-hook) |
| 1204 | 1201 | ||
| 1205 | (defun gnus-registry-install-p () | 1202 | (defun gnus-registry-install-p () |
| 1206 | "Return non-nil if the registry is enabled (and maybe enable it first). | 1203 | "Return non-nil if the registry is enabled (and maybe enable it first). |
| @@ -1234,7 +1231,7 @@ data stored in the registry." | |||
| 1234 | (seen-groups (list (gnus-group-group-name)))) | 1231 | (seen-groups (list (gnus-group-group-name)))) |
| 1235 | 1232 | ||
| 1236 | (catch 'found | 1233 | (catch 'found |
| 1237 | (dolist (group (mapcar 'gnus-simplify-group-name groups)) | 1234 | (dolist (group (mapcar #'gnus-simplify-group-name groups)) |
| 1238 | 1235 | ||
| 1239 | ;; skip over any groups we really don't want to warp to. | 1236 | ;; skip over any groups we really don't want to warp to. |
| 1240 | (unless (or (member group seen-groups) | 1237 | (unless (or (member group seen-groups) |
| @@ -1270,7 +1267,7 @@ EXTRA is a list of symbols. Valid symbols are those contained in | |||
| 1270 | the docs of `gnus-registry-track-extra'. This command is useful | 1267 | the docs of `gnus-registry-track-extra'. This command is useful |
| 1271 | when you stop tracking some extra data and now want to purge it | 1268 | when you stop tracking some extra data and now want to purge it |
| 1272 | from your existing entries." | 1269 | from your existing entries." |
| 1273 | (interactive (list (mapcar 'intern | 1270 | (interactive (list (mapcar #'intern |
| 1274 | (completing-read-multiple | 1271 | (completing-read-multiple |
| 1275 | "Extra data: " | 1272 | "Extra data: " |
| 1276 | '("subject" "sender" "recipient"))))) | 1273 | '("subject" "sender" "recipient"))))) |
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el index b8542bc3c35..ff59a72ac87 100644 --- a/lisp/image/gravatar.el +++ b/lisp/image/gravatar.el | |||
| @@ -26,6 +26,7 @@ | |||
| 26 | 26 | ||
| 27 | (require 'url) | 27 | (require 'url) |
| 28 | (require 'url-cache) | 28 | (require 'url-cache) |
| 29 | (require 'dns) | ||
| 29 | (eval-when-compile | 30 | (eval-when-compile |
| 30 | (require 'subr-x)) | 31 | (require 'subr-x)) |
| 31 | 32 | ||
| @@ -118,9 +119,42 @@ a gravatar for a given email address." | |||
| 118 | :version "27.1" | 119 | :version "27.1" |
| 119 | :group 'gravatar) | 120 | :group 'gravatar) |
| 120 | 121 | ||
| 121 | (defconst gravatar-base-url | 122 | (defconst gravatar-service-alist |
| 122 | "https://www.gravatar.com/avatar" | 123 | `((gravatar . ,(lambda (_addr) "https://www.gravatar.com/avatar")) |
| 123 | "Base URL for getting gravatars.") | 124 | (unicornify . ,(lambda (_addr) "https://unicornify.pictures/avatar/")) |
| 125 | (libravatar . ,#'gravatar--service-libravatar)) | ||
| 126 | "Alist of supported gravatar services.") | ||
| 127 | |||
| 128 | (defcustom gravatar-service 'libravatar | ||
| 129 | "Symbol denoting gravatar-like service to use. | ||
| 130 | Note that certain services might ignore other options, such as | ||
| 131 | `gravatar-default-image' or certain values as with | ||
| 132 | `gravatar-rating'." | ||
| 133 | :type `(choice ,@(mapcar (lambda (s) `(const ,(car s))) | ||
| 134 | gravatar-service-alist)) | ||
| 135 | :version "28.1" | ||
| 136 | :link '(url-link "https://www.libravatar.org/") | ||
| 137 | :link '(url-link "https://unicornify.pictures/") | ||
| 138 | :link '(url-link "https://gravatar.com/") | ||
| 139 | :group 'gravatar) | ||
| 140 | |||
| 141 | (defun gravatar--service-libravatar (addr) | ||
| 142 | "Find domain that hosts avatars for email address ADDR." | ||
| 143 | ;; implements https://wiki.libravatar.org/api/ | ||
| 144 | (save-match-data | ||
| 145 | (if (not (string-match ".+@\\(.+\\)" addr)) | ||
| 146 | "https://seccdn.libravatar.org/avatar" | ||
| 147 | (let ((domain (match-string 1 addr))) | ||
| 148 | (catch 'found | ||
| 149 | (dolist (record '(("_avatars-sec" . "https") | ||
| 150 | ("_avatars" . "http"))) | ||
| 151 | (let* ((query (concat (car record) "._tcp." domain)) | ||
| 152 | (result (dns-query query 'SRV))) | ||
| 153 | (when result | ||
| 154 | (throw 'found (format "%s://%s/avatar" | ||
| 155 | (cdr record) | ||
| 156 | result))))) | ||
| 157 | "https://seccdn.libravatar.org/avatar"))))) | ||
| 124 | 158 | ||
| 125 | (defun gravatar-hash (mail-address) | 159 | (defun gravatar-hash (mail-address) |
| 126 | "Return the Gravatar hash for MAIL-ADDRESS." | 160 | "Return the Gravatar hash for MAIL-ADDRESS." |
| @@ -142,7 +176,8 @@ a gravatar for a given email address." | |||
| 142 | "Return the URL of a gravatar for MAIL-ADDRESS." | 176 | "Return the URL of a gravatar for MAIL-ADDRESS." |
| 143 | ;; https://gravatar.com/site/implement/images/ | 177 | ;; https://gravatar.com/site/implement/images/ |
| 144 | (format "%s/%s?%s" | 178 | (format "%s/%s?%s" |
| 145 | gravatar-base-url | 179 | (funcall (alist-get gravatar-service gravatar-service-alist) |
| 180 | mail-address) | ||
| 146 | (gravatar-hash mail-address) | 181 | (gravatar-hash mail-address) |
| 147 | (gravatar--query-string))) | 182 | (gravatar--query-string))) |
| 148 | 183 | ||
diff --git a/lisp/isearch.el b/lisp/isearch.el index ddf9190dc6d..7625ec12b58 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el | |||
| @@ -2011,15 +2011,16 @@ Turning on character-folding turns off regexp mode.") | |||
| 2011 | (defvar isearch-message-properties minibuffer-prompt-properties | 2011 | (defvar isearch-message-properties minibuffer-prompt-properties |
| 2012 | "Text properties that are added to the isearch prompt.") | 2012 | "Text properties that are added to the isearch prompt.") |
| 2013 | 2013 | ||
| 2014 | (defun isearch--momentary-message (string) | 2014 | (defun isearch--momentary-message (string &optional seconds) |
| 2015 | "Print STRING at the end of the isearch prompt for 1 second." | 2015 | "Print STRING at the end of the isearch prompt for 1 second. |
| 2016 | The optional argument SECONDS overrides the number of seconds." | ||
| 2016 | (let ((message-log-max nil)) | 2017 | (let ((message-log-max nil)) |
| 2017 | (message "%s%s%s" | 2018 | (message "%s%s%s" |
| 2018 | (isearch-message-prefix nil isearch-nonincremental) | 2019 | (isearch-message-prefix nil isearch-nonincremental) |
| 2019 | isearch-message | 2020 | isearch-message |
| 2020 | (apply #'propertize (format " [%s]" string) | 2021 | (apply #'propertize (format " [%s]" string) |
| 2021 | isearch-message-properties))) | 2022 | isearch-message-properties))) |
| 2022 | (sit-for 1)) | 2023 | (sit-for (or seconds 1))) |
| 2023 | 2024 | ||
| 2024 | (isearch-define-mode-toggle lax-whitespace " " nil | 2025 | (isearch-define-mode-toggle lax-whitespace " " nil |
| 2025 | "In ordinary search, toggles the value of the variable | 2026 | "In ordinary search, toggles the value of the variable |
| @@ -3443,7 +3444,10 @@ Optional third argument, if t, means if fail just return nil (no error). | |||
| 3443 | (string-match "\\`Regular expression too big" isearch-error)) | 3444 | (string-match "\\`Regular expression too big" isearch-error)) |
| 3444 | (cond | 3445 | (cond |
| 3445 | (isearch-regexp-function | 3446 | (isearch-regexp-function |
| 3446 | (setq isearch-error "Too many words")) | 3447 | (setq isearch-error nil) |
| 3448 | (setq isearch-regexp-function nil) | ||
| 3449 | (isearch-search-and-update) | ||
| 3450 | (isearch--momentary-message "Too many words; switched to literal mode" 2)) | ||
| 3447 | ((and isearch-lax-whitespace search-whitespace-regexp) | 3451 | ((and isearch-lax-whitespace search-whitespace-regexp) |
| 3448 | (setq isearch-error "Too many spaces for whitespace matching")))))) | 3452 | (setq isearch-error "Too many spaces for whitespace matching")))))) |
| 3449 | 3453 | ||
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index d73cd74da0b..9cdb108be03 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el | |||
| @@ -48,8 +48,7 @@ Preserves the `buffer-modified-p' state of the current buffer." | |||
| 48 | "Jit-lock fontifies chunks of at most this many characters at a time. | 48 | "Jit-lock fontifies chunks of at most this many characters at a time. |
| 49 | 49 | ||
| 50 | This variable controls both display-time and stealth fontification." | 50 | This variable controls both display-time and stealth fontification." |
| 51 | :type 'integer | 51 | :type 'integer) |
| 52 | :group 'jit-lock) | ||
| 53 | 52 | ||
| 54 | 53 | ||
| 55 | (defcustom jit-lock-stealth-time nil | 54 | (defcustom jit-lock-stealth-time nil |
| @@ -59,8 +58,7 @@ If nil, stealth fontification is never performed. | |||
| 59 | 58 | ||
| 60 | The value of this variable is used when JIT Lock mode is turned on." | 59 | The value of this variable is used when JIT Lock mode is turned on." |
| 61 | :type '(choice (const :tag "never" nil) | 60 | :type '(choice (const :tag "never" nil) |
| 62 | (number :tag "seconds" :value 16)) | 61 | (number :tag "seconds" :value 16))) |
| 63 | :group 'jit-lock) | ||
| 64 | 62 | ||
| 65 | 63 | ||
| 66 | (defcustom jit-lock-stealth-nice 0.5 | 64 | (defcustom jit-lock-stealth-nice 0.5 |
| @@ -72,8 +70,7 @@ To reduce machine load during stealth fontification, at the cost of stealth | |||
| 72 | taking longer to fontify, you could increase the value of this variable. | 70 | taking longer to fontify, you could increase the value of this variable. |
| 73 | See also `jit-lock-stealth-load'." | 71 | See also `jit-lock-stealth-load'." |
| 74 | :type '(choice (const :tag "never" nil) | 72 | :type '(choice (const :tag "never" nil) |
| 75 | (number :tag "seconds")) | 73 | (number :tag "seconds"))) |
| 76 | :group 'jit-lock) | ||
| 77 | 74 | ||
| 78 | 75 | ||
| 79 | (defcustom jit-lock-stealth-load | 76 | (defcustom jit-lock-stealth-load |
| @@ -89,14 +86,12 @@ See also `jit-lock-stealth-nice'." | |||
| 89 | :type (if (condition-case nil (load-average) (error)) | 86 | :type (if (condition-case nil (load-average) (error)) |
| 90 | '(choice (const :tag "never" nil) | 87 | '(choice (const :tag "never" nil) |
| 91 | (integer :tag "load")) | 88 | (integer :tag "load")) |
| 92 | '(const :format "%t: unsupported\n" nil)) | 89 | '(const :format "%t: unsupported\n" nil))) |
| 93 | :group 'jit-lock) | ||
| 94 | 90 | ||
| 95 | 91 | ||
| 96 | (defcustom jit-lock-stealth-verbose nil | 92 | (defcustom jit-lock-stealth-verbose nil |
| 97 | "If non-nil, means stealth fontification should show status messages." | 93 | "If non-nil, means stealth fontification should show status messages." |
| 98 | :type 'boolean | 94 | :type 'boolean) |
| 99 | :group 'jit-lock) | ||
| 100 | 95 | ||
| 101 | 96 | ||
| 102 | (defvaralias 'jit-lock-defer-contextually 'jit-lock-contextually) | 97 | (defvaralias 'jit-lock-defer-contextually 'jit-lock-contextually) |
| @@ -115,13 +110,11 @@ buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil. | |||
| 115 | The value of this variable is used when JIT Lock mode is turned on." | 110 | The value of this variable is used when JIT Lock mode is turned on." |
| 116 | :type '(choice (const :tag "never" nil) | 111 | :type '(choice (const :tag "never" nil) |
| 117 | (const :tag "always" t) | 112 | (const :tag "always" t) |
| 118 | (other :tag "syntax-driven" syntax-driven)) | 113 | (other :tag "syntax-driven" syntax-driven))) |
| 119 | :group 'jit-lock) | ||
| 120 | 114 | ||
| 121 | (defcustom jit-lock-context-time 0.5 | 115 | (defcustom jit-lock-context-time 0.5 |
| 122 | "Idle time after which text is contextually refontified, if applicable." | 116 | "Idle time after which text is contextually refontified, if applicable." |
| 123 | :type '(number :tag "seconds") | 117 | :type '(number :tag "seconds")) |
| 124 | :group 'jit-lock) | ||
| 125 | 118 | ||
| 126 | (defcustom jit-lock-antiblink-grace 2 | 119 | (defcustom jit-lock-antiblink-grace 2 |
| 127 | "Delay after which to refontify unterminated strings and comments. | 120 | "Delay after which to refontify unterminated strings and comments. |
| @@ -134,14 +127,12 @@ and comments, the delay helps avoid unpleasant \"blinking\", between | |||
| 134 | string/comment and non-string/non-comment fontification." | 127 | string/comment and non-string/non-comment fontification." |
| 135 | :type '(choice (const :tag "never" nil) | 128 | :type '(choice (const :tag "never" nil) |
| 136 | (number :tag "seconds")) | 129 | (number :tag "seconds")) |
| 137 | :group 'jit-lock | ||
| 138 | :version "27.1") | 130 | :version "27.1") |
| 139 | 131 | ||
| 140 | (defcustom jit-lock-defer-time nil ;; 0.25 | 132 | (defcustom jit-lock-defer-time nil ;; 0.25 |
| 141 | "Idle time after which deferred fontification should take place. | 133 | "Idle time after which deferred fontification should take place. |
| 142 | If nil, fontification is not deferred. | 134 | If nil, fontification is not deferred. |
| 143 | If 0, then fontification is only deferred while there is input pending." | 135 | If 0, then fontification is only deferred while there is input pending." |
| 144 | :group 'jit-lock | ||
| 145 | :type '(choice (const :tag "never" nil) | 136 | :type '(choice (const :tag "never" nil) |
| 146 | (number :tag "seconds"))) | 137 | (number :tag "seconds"))) |
| 147 | 138 | ||
| @@ -262,7 +253,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'." | |||
| 262 | 253 | ||
| 263 | ;; Setup our hooks. | 254 | ;; Setup our hooks. |
| 264 | (add-hook 'after-change-functions 'jit-lock-after-change nil t) | 255 | (add-hook 'after-change-functions 'jit-lock-after-change nil t) |
| 265 | (add-hook 'fontification-functions 'jit-lock-function)) | 256 | (add-hook 'fontification-functions 'jit-lock-function nil t)) |
| 266 | 257 | ||
| 267 | ;; Turn Just-in-time Lock mode off. | 258 | ;; Turn Just-in-time Lock mode off. |
| 268 | (t | 259 | (t |
| @@ -294,7 +285,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'." | |||
| 294 | When this minor mode is enabled, jit-lock runs as little code as possible | 285 | When this minor mode is enabled, jit-lock runs as little code as possible |
| 295 | during redisplay and moves the rest to a timer, where things | 286 | during redisplay and moves the rest to a timer, where things |
| 296 | like `debug-on-error' and Edebug can be used." | 287 | like `debug-on-error' and Edebug can be used." |
| 297 | :global t :group 'jit-lock | 288 | :global t |
| 298 | (when jit-lock-defer-timer | 289 | (when jit-lock-defer-timer |
| 299 | (cancel-timer jit-lock-defer-timer) | 290 | (cancel-timer jit-lock-defer-timer) |
| 300 | (setq jit-lock-defer-timer nil)) | 291 | (setq jit-lock-defer-timer nil)) |
| @@ -438,8 +429,8 @@ Defaults to the whole buffer. END can be out of bounds." | |||
| 438 | (quit (put-text-property start next 'fontified nil) | 429 | (quit (put-text-property start next 'fontified nil) |
| 439 | (signal (car err) (cdr err)))))) | 430 | (signal (car err) (cdr err)))))) |
| 440 | 431 | ||
| 441 | ;; In case we fontified more than requested, take advantage of the | 432 | ;; In case we fontified more than requested, take |
| 442 | ;; good news. | 433 | ;; advantage of the good news. |
| 443 | (when (or (< tight-beg start) (> tight-end next)) | 434 | (when (or (< tight-beg start) (> tight-end next)) |
| 444 | (put-text-property tight-beg tight-end 'fontified t)) | 435 | (put-text-property tight-beg tight-end 'fontified t)) |
| 445 | 436 | ||
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 2952242c251..8851522bbdb 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el | |||
| @@ -435,9 +435,9 @@ not contain `d', so that a full listing is expected." | |||
| 435 | ;; text. But if the listing is empty, as e.g. in empty | 435 | ;; text. But if the listing is empty, as e.g. in empty |
| 436 | ;; directories with -a removed from switches, point will be | 436 | ;; directories with -a removed from switches, point will be |
| 437 | ;; before the inserted text, and dired-insert-directory will | 437 | ;; before the inserted text, and dired-insert-directory will |
| 438 | ;; not indent the listing correctly. Going to the end of the | 438 | ;; not indent the listing correctly. Getting past the |
| 439 | ;; buffer fixes that. | 439 | ;; inserted text solves this. |
| 440 | (unless files (goto-char (point-max))) | 440 | (unless (cdr total-line) (forward-line 2)) |
| 441 | (if (memq ?R switches) | 441 | (if (memq ?R switches) |
| 442 | ;; List the contents of all directories recursively. | 442 | ;; List the contents of all directories recursively. |
| 443 | ;; cadr of each element of `file-alist' is t for | 443 | ;; cadr of each element of `file-alist' is t for |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index bfeaebac2cd..aae25d1dbf3 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -629,9 +629,6 @@ But handle the case, if the \"test\" command is not available." | |||
| 629 | (format "File %s exists; overwrite anyway? " filename))))) | 629 | (format "File %s exists; overwrite anyway? " filename))))) |
| 630 | (tramp-error v 'file-already-exists filename)) | 630 | (tramp-error v 'file-already-exists filename)) |
| 631 | 631 | ||
| 632 | ;; We must also flush the cache of the directory, because | ||
| 633 | ;; `file-attributes' reads the values from there. | ||
| 634 | (tramp-flush-file-properties v localname) | ||
| 635 | (let* ((curbuf (current-buffer)) | 632 | (let* ((curbuf (current-buffer)) |
| 636 | (tmpfile (tramp-compat-make-temp-file filename))) | 633 | (tmpfile (tramp-compat-make-temp-file filename))) |
| 637 | (when (and append (file-exists-p filename)) | 634 | (when (and append (file-exists-p filename)) |
| @@ -648,6 +645,10 @@ But handle the case, if the \"test\" command is not available." | |||
| 648 | (tramp-error v 'file-error "Cannot write: `%s'" filename)) | 645 | (tramp-error v 'file-error "Cannot write: `%s'" filename)) |
| 649 | (delete-file tmpfile))) | 646 | (delete-file tmpfile))) |
| 650 | 647 | ||
| 648 | ;; We must also flush the cache of the directory, because | ||
| 649 | ;; `file-attributes' reads the values from there. | ||
| 650 | (tramp-flush-file-properties v localname) | ||
| 651 | |||
| 651 | (unless (equal curbuf (current-buffer)) | 652 | (unless (equal curbuf (current-buffer)) |
| 652 | (tramp-error | 653 | (tramp-error |
| 653 | v 'file-error | 654 | v 'file-error |
| @@ -1096,7 +1097,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 1096 | "Like `exec-path' for Tramp files." | 1097 | "Like `exec-path' for Tramp files." |
| 1097 | (append | 1098 | (append |
| 1098 | (with-parsed-tramp-file-name default-directory nil | 1099 | (with-parsed-tramp-file-name default-directory nil |
| 1099 | (with-tramp-connection-property v "remote-path" | 1100 | (with-tramp-connection-property (tramp-get-process v) "remote-path" |
| 1100 | (tramp-adb-send-command v "echo \\\"$PATH\\\"") | 1101 | (tramp-adb-send-command v "echo \\\"$PATH\\\"") |
| 1101 | (split-string | 1102 | (split-string |
| 1102 | (with-current-buffer (tramp-get-connection-buffer v) | 1103 | (with-current-buffer (tramp-get-connection-buffer v) |
| @@ -1111,11 +1112,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 1111 | "Return full host name from VEC to be used in shell execution. | 1112 | "Return full host name from VEC to be used in shell execution. |
| 1112 | E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" | 1113 | E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" |
| 1113 | a host name \"R38273882DE\" returns \"R38273882DE\"." | 1114 | a host name \"R38273882DE\" returns \"R38273882DE\"." |
| 1114 | ;; Sometimes this is called before there is a connection process | 1115 | (with-tramp-connection-property (tramp-get-process vec) "device" |
| 1115 | ;; yet. In order to work with the connection cache, we flush all | ||
| 1116 | ;; unwanted entries first. | ||
| 1117 | (tramp-flush-connection-properties nil) | ||
| 1118 | (with-tramp-connection-property (tramp-get-connection-process vec) "device" | ||
| 1119 | (let* ((host (tramp-file-name-host vec)) | 1116 | (let* ((host (tramp-file-name-host vec)) |
| 1120 | (port (tramp-file-name-port-or-default vec)) | 1117 | (port (tramp-file-name-port-or-default vec)) |
| 1121 | (devices (mapcar #'cadr (tramp-adb-parse-device-names nil)))) | 1118 | (devices (mapcar #'cadr (tramp-adb-parse-device-names nil)))) |
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 91ed5465695..93eeb16f547 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el | |||
| @@ -31,13 +31,13 @@ | |||
| 31 | ;; a process, has a unique cache. We distinguish 4 kind of caches, | 31 | ;; a process, has a unique cache. We distinguish 4 kind of caches, |
| 32 | ;; depending on the key: | 32 | ;; depending on the key: |
| 33 | ;; | 33 | ;; |
| 34 | ;; - localname is NIL. This are reusable properties. Examples: | 34 | ;; - localname is nil. These are reusable properties. Examples: |
| 35 | ;; "remote-shell" identifies the POSIX shell to be called on the | 35 | ;; "remote-shell" identifies the POSIX shell to be called on the |
| 36 | ;; remote host, or "perl" is the command to be called on the remote | 36 | ;; remote host, or "perl" is the command to be called on the remote |
| 37 | ;; host when starting a Perl script. These properties are saved in | 37 | ;; host when starting a Perl script. These properties are saved in |
| 38 | ;; the file `tramp-persistency-file-name'. | 38 | ;; the file `tramp-persistency-file-name'. |
| 39 | ;; | 39 | ;; |
| 40 | ;; - localname is a string. This are temporary properties, which are | 40 | ;; - localname is a string. These are temporary properties, which are |
| 41 | ;; related to the file localname is referring to. Examples: | 41 | ;; related to the file localname is referring to. Examples: |
| 42 | ;; "file-exists-p" is t or nil, depending on the file existence, or | 42 | ;; "file-exists-p" is t or nil, depending on the file existence, or |
| 43 | ;; "file-attributes" caches the result of the function | 43 | ;; "file-attributes" caches the result of the function |
| @@ -45,21 +45,32 @@ | |||
| 45 | ;; expire after `remote-file-name-inhibit-cache' seconds if this | 45 | ;; expire after `remote-file-name-inhibit-cache' seconds if this |
| 46 | ;; variable is set. | 46 | ;; variable is set. |
| 47 | ;; | 47 | ;; |
| 48 | ;; - The key is a process. This are temporary properties related to | 48 | ;; - The key is a process. These are temporary properties related to |
| 49 | ;; an open connection. Examples: "scripts" keeps shell script | 49 | ;; an open connection. Examples: "scripts" keeps shell script |
| 50 | ;; definitions already sent to the remote shell, "last-cmd-time" is | 50 | ;; definitions already sent to the remote shell, "last-cmd-time" is |
| 51 | ;; the time stamp a command has been sent to the remote process. | 51 | ;; the time stamp a command has been sent to the remote process. |
| 52 | ;; | 52 | ;; |
| 53 | ;; - The key is nil. This are temporary properties related to the | 53 | ;; - The key is nil. These are temporary properties related to the |
| 54 | ;; local machine. Examples: "parse-passwd" and "parse-group" keep | 54 | ;; local machine. Examples: "parse-passwd" and "parse-group" keep |
| 55 | ;; the results of parsing "/etc/passwd" and "/etc/group", | 55 | ;; the results of parsing "/etc/passwd" and "/etc/group", |
| 56 | ;; "{uid,gid}-{integer,string}" are the local uid and gid, and | 56 | ;; "{uid,gid}-{integer,string}" are the local uid and gid, and |
| 57 | ;; "locale" is the used shell locale. | 57 | ;; "locale" is the used shell locale. |
| 58 | ;; | ||
| 59 | ;; - The key is `tramp-cache-undefined'. All functions return the | ||
| 60 | ;; expected values, but nothing is cached. | ||
| 58 | 61 | ||
| 59 | ;; Some properties are handled special: | 62 | ;; Some properties are handled special: |
| 60 | ;; | 63 | ;; |
| 61 | ;; - "process-name", "process-buffer" and "first-password-request" are | 64 | ;; - "process-name", "process-buffer" and "first-password-request" are |
| 62 | ;; not saved in the file `tramp-persistency-file-name'. | 65 | ;; not saved in the file `tramp-persistency-file-name', although |
| 66 | ;; being connection properties related to a `tramp-file-name' | ||
| 67 | ;; structure. | ||
| 68 | ;; | ||
| 69 | ;; - Reusable properties, which should not be saved, are kept in the | ||
| 70 | ;; process key retrieved by `tramp-get-process' (the main connection | ||
| 71 | ;; process). Other processes could reuse these properties, avoiding | ||
| 72 | ;; recomputation when a new asynchronous process is created by | ||
| 73 | ;; `make-process'. Examples are "remote-path" or "device" (tramp-adb.el). | ||
| 63 | 74 | ||
| 64 | ;;; Code: | 75 | ;;; Code: |
| 65 | 76 | ||
| @@ -96,25 +107,31 @@ details see the info pages." | |||
| 96 | (defvar tramp-cache-data-changed nil | 107 | (defvar tramp-cache-data-changed nil |
| 97 | "Whether persistent cache data have been changed.") | 108 | "Whether persistent cache data have been changed.") |
| 98 | 109 | ||
| 110 | ;;;###tramp-autoload | ||
| 111 | (defconst tramp-cache-undefined 'undef | ||
| 112 | "The symbol marking undefined hash keys and values.") | ||
| 113 | |||
| 99 | (defun tramp-get-hash-table (key) | 114 | (defun tramp-get-hash-table (key) |
| 100 | "Return the hash table for KEY. | 115 | "Return the hash table for KEY. |
| 101 | If it doesn't exist yet, it is created and initialized with | 116 | If it doesn't exist yet, it is created and initialized with |
| 102 | matching entries of `tramp-connection-properties'." | 117 | matching entries of `tramp-connection-properties'. |
| 103 | (or (gethash key tramp-cache-data) | 118 | If KEY is `tramp-cache-undefined', don't create anything, and return nil." |
| 104 | (let ((hash | 119 | (unless (eq key tramp-cache-undefined) |
| 105 | (puthash key (make-hash-table :test #'equal) tramp-cache-data))) | 120 | (or (gethash key tramp-cache-data) |
| 106 | (when (tramp-file-name-p key) | 121 | (let ((hash |
| 107 | (dolist (elt tramp-connection-properties) | 122 | (puthash key (make-hash-table :test #'equal) tramp-cache-data))) |
| 108 | (when (string-match-p | 123 | (when (tramp-file-name-p key) |
| 109 | (or (nth 0 elt) "") | 124 | (dolist (elt tramp-connection-properties) |
| 110 | (tramp-make-tramp-file-name key 'noloc 'nohop)) | 125 | (when (string-match-p |
| 111 | (tramp-set-connection-property key (nth 1 elt) (nth 2 elt))))) | 126 | (or (nth 0 elt) "") |
| 112 | hash))) | 127 | (tramp-make-tramp-file-name key 'noloc 'nohop)) |
| 128 | (tramp-set-connection-property key (nth 1 elt) (nth 2 elt))))) | ||
| 129 | hash)))) | ||
| 113 | 130 | ||
| 114 | ;;;###tramp-autoload | 131 | ;;;###tramp-autoload |
| 115 | (defun tramp-get-file-property (key file property default) | 132 | (defun tramp-get-file-property (key file property default) |
| 116 | "Get the PROPERTY of FILE from the cache context of KEY. | 133 | "Get the PROPERTY of FILE from the cache context of KEY. |
| 117 | Returns DEFAULT if not set." | 134 | Return DEFAULT if not set." |
| 118 | ;; Unify localname. Remove hop from `tramp-file-name' structure. | 135 | ;; Unify localname. Remove hop from `tramp-file-name' structure. |
| 119 | (setq file (tramp-compat-file-name-unquote file) | 136 | (setq file (tramp-compat-file-name-unquote file) |
| 120 | key (copy-tramp-file-name key)) | 137 | key (copy-tramp-file-name key)) |
| @@ -152,7 +169,7 @@ Returns DEFAULT if not set." | |||
| 152 | ;;;###tramp-autoload | 169 | ;;;###tramp-autoload |
| 153 | (defun tramp-set-file-property (key file property value) | 170 | (defun tramp-set-file-property (key file property value) |
| 154 | "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. | 171 | "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. |
| 155 | Returns VALUE." | 172 | Return VALUE." |
| 156 | ;; Unify localname. Remove hop from `tramp-file-name' structure. | 173 | ;; Unify localname. Remove hop from `tramp-file-name' structure. |
| 157 | (setq file (tramp-compat-file-name-unquote file) | 174 | (setq file (tramp-compat-file-name-unquote file) |
| 158 | key (copy-tramp-file-name key)) | 175 | key (copy-tramp-file-name key)) |
| @@ -283,8 +300,9 @@ This is suppressed for temporary buffers." | |||
| 283 | "Get the named PROPERTY for the connection. | 300 | "Get the named PROPERTY for the connection. |
| 284 | KEY identifies the connection, it is either a process or a | 301 | KEY identifies the connection, it is either a process or a |
| 285 | `tramp-file-name' structure. A special case is nil, which is | 302 | `tramp-file-name' structure. A special case is nil, which is |
| 286 | used to cache connection properties of the local machine. If the | 303 | used to cache connection properties of the local machine. |
| 287 | value is not set for the connection, returns DEFAULT." | 304 | If KEY is `tramp-cache-undefined', or if the value is not set for |
| 305 | the connection, return DEFAULT." | ||
| 288 | ;; Unify key by removing localname and hop from `tramp-file-name' | 306 | ;; Unify key by removing localname and hop from `tramp-file-name' |
| 289 | ;; structure. Work with a copy in order to avoid side effects. | 307 | ;; structure. Work with a copy in order to avoid side effects. |
| 290 | (when (tramp-file-name-p key) | 308 | (when (tramp-file-name-p key) |
| @@ -308,19 +326,22 @@ value is not set for the connection, returns DEFAULT." | |||
| 308 | "Set the named PROPERTY of a connection to VALUE. | 326 | "Set the named PROPERTY of a connection to VALUE. |
| 309 | KEY identifies the connection, it is either a process or a | 327 | KEY identifies the connection, it is either a process or a |
| 310 | `tramp-file-name' structure. A special case is nil, which is | 328 | `tramp-file-name' structure. A special case is nil, which is |
| 311 | used to cache connection properties of the local machine. | 329 | used to cache connection properties of the local machine. If KEY |
| 312 | PROPERTY is set persistent when KEY is a `tramp-file-name' structure." | 330 | is `tramp-cache-undefined', nothing is set. |
| 331 | PROPERTY is set persistent when KEY is a `tramp-file-name' structure. | ||
| 332 | Return VALUE." | ||
| 313 | ;; Unify key by removing localname and hop from `tramp-file-name' | 333 | ;; Unify key by removing localname and hop from `tramp-file-name' |
| 314 | ;; structure. Work with a copy in order to avoid side effects. | 334 | ;; structure. Work with a copy in order to avoid side effects. |
| 315 | (when (tramp-file-name-p key) | 335 | (when (tramp-file-name-p key) |
| 316 | (setq key (copy-tramp-file-name key)) | 336 | (setq key (copy-tramp-file-name key)) |
| 317 | (setf (tramp-file-name-localname key) nil | 337 | (setf (tramp-file-name-localname key) nil |
| 318 | (tramp-file-name-hop key) nil)) | 338 | (tramp-file-name-hop key) nil)) |
| 319 | (let ((hash (tramp-get-hash-table key))) | 339 | (when-let ((hash (tramp-get-hash-table key))) |
| 320 | (puthash property value hash) | 340 | (puthash property value hash)) |
| 321 | (setq tramp-cache-data-changed t) | 341 | (setq tramp-cache-data-changed |
| 322 | (tramp-message key 7 "%s %s" property value) | 342 | (or tramp-cache-data-changed (tramp-tramp-file-p key))) |
| 323 | value)) | 343 | (tramp-message key 7 "%s %s" property value) |
| 344 | value) | ||
| 324 | 345 | ||
| 325 | ;;;###tramp-autoload | 346 | ;;;###tramp-autoload |
| 326 | (defun tramp-connection-property-p (key property) | 347 | (defun tramp-connection-property-p (key property) |
| @@ -328,7 +349,8 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure." | |||
| 328 | KEY identifies the connection, it is either a process or a | 349 | KEY identifies the connection, it is either a process or a |
| 329 | `tramp-file-name' structure. A special case is nil, which is | 350 | `tramp-file-name' structure. A special case is nil, which is |
| 330 | used to cache connection properties of the local machine." | 351 | used to cache connection properties of the local machine." |
| 331 | (not (eq (tramp-get-connection-property key property 'undef) 'undef))) | 352 | (not (eq (tramp-get-connection-property key property tramp-cache-undefined) |
| 353 | tramp-cache-undefined))) | ||
| 332 | 354 | ||
| 333 | ;;;###tramp-autoload | 355 | ;;;###tramp-autoload |
| 334 | (defun tramp-flush-connection-property (key property) | 356 | (defun tramp-flush-connection-property (key property) |
| @@ -343,8 +365,10 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure." | |||
| 343 | (setq key (copy-tramp-file-name key)) | 365 | (setq key (copy-tramp-file-name key)) |
| 344 | (setf (tramp-file-name-localname key) nil | 366 | (setf (tramp-file-name-localname key) nil |
| 345 | (tramp-file-name-hop key) nil)) | 367 | (tramp-file-name-hop key) nil)) |
| 346 | (remhash property (tramp-get-hash-table key)) | 368 | (when-let ((hash (tramp-get-hash-table key))) |
| 347 | (setq tramp-cache-data-changed t) | 369 | (remhash property hash)) |
| 370 | (setq tramp-cache-data-changed | ||
| 371 | (or tramp-cache-data-changed (tramp-tramp-file-p key))) | ||
| 348 | (tramp-message key 7 "%s" property)) | 372 | (tramp-message key 7 "%s" property)) |
| 349 | 373 | ||
| 350 | ;;;###tramp-autoload | 374 | ;;;###tramp-autoload |
| @@ -361,9 +385,10 @@ used to cache connection properties of the local machine." | |||
| 361 | (tramp-file-name-hop key) nil)) | 385 | (tramp-file-name-hop key) nil)) |
| 362 | (tramp-message | 386 | (tramp-message |
| 363 | key 7 "%s %s" key | 387 | key 7 "%s %s" key |
| 364 | (let ((hash (gethash key tramp-cache-data))) | 388 | (when-let ((hash (gethash key tramp-cache-data))) |
| 365 | (when (hash-table-p hash) (hash-table-keys hash)))) | 389 | (hash-table-keys hash))) |
| 366 | (setq tramp-cache-data-changed t) | 390 | (setq tramp-cache-data-changed |
| 391 | (or tramp-cache-data-changed (tramp-tramp-file-p key))) | ||
| 367 | (remhash key tramp-cache-data)) | 392 | (remhash key tramp-cache-data)) |
| 368 | 393 | ||
| 369 | ;;;###tramp-autoload | 394 | ;;;###tramp-autoload |
| @@ -414,7 +439,8 @@ used to cache connection properties of the local machine." | |||
| 414 | (hash-table-keys tramp-cache-data))))) | 439 | (hash-table-keys tramp-cache-data))))) |
| 415 | 440 | ||
| 416 | (defun tramp-dump-connection-properties () | 441 | (defun tramp-dump-connection-properties () |
| 417 | "Write persistent connection properties into file `tramp-persistency-file-name'." | 442 | "Write persistent connection properties into file \ |
| 443 | `tramp-persistency-file-name'." | ||
| 418 | ;; We shouldn't fail, otherwise Emacs might not be able to be closed. | 444 | ;; We shouldn't fail, otherwise Emacs might not be able to be closed. |
| 419 | (ignore-errors | 445 | (ignore-errors |
| 420 | (when (and (hash-table-p tramp-cache-data) | 446 | (when (and (hash-table-p tramp-cache-data) |
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index b4dca2321c1..7d353e262af 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el | |||
| @@ -107,21 +107,19 @@ When called interactively, a Tramp connection has to be selected." | |||
| 107 | ;; suppressed. | 107 | ;; suppressed. |
| 108 | (setq tramp-current-connection nil) | 108 | (setq tramp-current-connection nil) |
| 109 | 109 | ||
| 110 | ;; Flush file cache. | ||
| 111 | (tramp-flush-directory-properties vec "") | ||
| 112 | |||
| 113 | ;; Flush connection cache. | ||
| 114 | (when (processp (tramp-get-connection-process vec)) | ||
| 115 | (tramp-flush-connection-properties (tramp-get-connection-process vec)) | ||
| 116 | (delete-process (tramp-get-connection-process vec))) | ||
| 117 | (tramp-flush-connection-properties vec) | ||
| 118 | |||
| 119 | ;; Cancel timer. | 110 | ;; Cancel timer. |
| 120 | (dolist (timer timer-list) | 111 | (dolist (timer timer-list) |
| 121 | (when (and (eq (timer--function timer) 'tramp-timeout-session) | 112 | (when (and (eq (timer--function timer) 'tramp-timeout-session) |
| 122 | (tramp-file-name-equal-p vec (car (timer--args timer)))) | 113 | (tramp-file-name-equal-p vec (car (timer--args timer)))) |
| 123 | (cancel-timer timer))) | 114 | (cancel-timer timer))) |
| 124 | 115 | ||
| 116 | ;; Delete processes. | ||
| 117 | (dolist (key (hash-table-keys tramp-cache-data)) | ||
| 118 | (when (and (processp key) | ||
| 119 | (tramp-file-name-equal-p (process-get key 'vector) vec)) | ||
| 120 | (tramp-flush-connection-properties key) | ||
| 121 | (delete-process key))) | ||
| 122 | |||
| 125 | ;; Remove buffers. | 123 | ;; Remove buffers. |
| 126 | (dolist | 124 | (dolist |
| 127 | (buf (list (get-buffer (tramp-buffer-name vec)) | 125 | (buf (list (get-buffer (tramp-buffer-name vec)) |
| @@ -130,6 +128,12 @@ When called interactively, a Tramp connection has to be selected." | |||
| 130 | (tramp-get-connection-property vec "process-buffer" nil))) | 128 | (tramp-get-connection-property vec "process-buffer" nil))) |
| 131 | (when (bufferp buf) (kill-buffer buf))) | 129 | (when (bufferp buf) (kill-buffer buf))) |
| 132 | 130 | ||
| 131 | ;; Flush file cache. | ||
| 132 | (tramp-flush-directory-properties vec "") | ||
| 133 | |||
| 134 | ;; Flush connection cache. | ||
| 135 | (tramp-flush-connection-properties vec) | ||
| 136 | |||
| 133 | ;; The end. | 137 | ;; The end. |
| 134 | (run-hook-with-args 'tramp-cleanup-connection-hook vec))) | 138 | (run-hook-with-args 'tramp-cleanup-connection-hook vec))) |
| 135 | 139 | ||
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 85f28076168..526c564ee33 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -1731,8 +1731,7 @@ a downcased host name only." | |||
| 1731 | (list | 1731 | (list |
| 1732 | t ;; handled. | 1732 | t ;; handled. |
| 1733 | nil ;; no abort of D-Bus. | 1733 | nil ;; no abort of D-Bus. |
| 1734 | (with-tramp-connection-property | 1734 | (with-tramp-connection-property (tramp-get-process v) message |
| 1735 | (tramp-get-connection-process v) message | ||
| 1736 | ;; In theory, there can be several choices. | 1735 | ;; In theory, there can be several choices. |
| 1737 | ;; Until now, there is only the question whether | 1736 | ;; Until now, there is only the question whether |
| 1738 | ;; to accept an unknown host signature or certificate. | 1737 | ;; to accept an unknown host signature or certificate. |
| @@ -1946,8 +1945,7 @@ a downcased host name only." | |||
| 1946 | (tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec)))) | 1945 | (tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec)))) |
| 1947 | (while (tramp-gvfs-connection-mounted-p vec) | 1946 | (while (tramp-gvfs-connection-mounted-p vec) |
| 1948 | (read-event nil nil 0.1)) | 1947 | (read-event nil nil 0.1)) |
| 1949 | (tramp-flush-connection-properties vec) | 1948 | (tramp-cleanup-connection vec 'keep-debug 'keep-password)) |
| 1950 | (tramp-flush-connection-properties (tramp-get-connection-process vec))) | ||
| 1951 | 1949 | ||
| 1952 | (defun tramp-gvfs-mount-spec-entry (key value) | 1950 | (defun tramp-gvfs-mount-spec-entry (key value) |
| 1953 | "Construct a mount-spec entry to be used in a mount_spec. | 1951 | "Construct a mount-spec entry to be used in a mount_spec. |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 06dca312275..c770e3ce400 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -1539,7 +1539,7 @@ of." | |||
| 1539 | 1539 | ||
| 1540 | (defun tramp-remote-selinux-p (vec) | 1540 | (defun tramp-remote-selinux-p (vec) |
| 1541 | "Check, whether SELINUX is enabled on the remote host." | 1541 | "Check, whether SELINUX is enabled on the remote host." |
| 1542 | (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p" | 1542 | (with-tramp-connection-property (tramp-get-process vec) "selinux-p" |
| 1543 | (tramp-send-command-and-check vec "selinuxenabled"))) | 1543 | (tramp-send-command-and-check vec "selinuxenabled"))) |
| 1544 | 1544 | ||
| 1545 | (defun tramp-sh-handle-file-selinux-context (filename) | 1545 | (defun tramp-sh-handle-file-selinux-context (filename) |
| @@ -1588,7 +1588,7 @@ of." | |||
| 1588 | 1588 | ||
| 1589 | (defun tramp-remote-acl-p (vec) | 1589 | (defun tramp-remote-acl-p (vec) |
| 1590 | "Check, whether ACL is enabled on the remote host." | 1590 | "Check, whether ACL is enabled on the remote host." |
| 1591 | (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p" | 1591 | (with-tramp-connection-property (tramp-get-process vec) "acl-p" |
| 1592 | (tramp-send-command-and-check vec "getfacl /"))) | 1592 | (tramp-send-command-and-check vec "getfacl /"))) |
| 1593 | 1593 | ||
| 1594 | (defun tramp-sh-handle-file-acl (filename) | 1594 | (defun tramp-sh-handle-file-acl (filename) |
| @@ -3580,23 +3580,29 @@ STDERR can also be a file name." | |||
| 3580 | remote-file-name-inhibit-cache process-file-side-effects) | 3580 | remote-file-name-inhibit-cache process-file-side-effects) |
| 3581 | ;; Reduce `vc-handled-backends' in order to minimize | 3581 | ;; Reduce `vc-handled-backends' in order to minimize |
| 3582 | ;; process calls. | 3582 | ;; process calls. |
| 3583 | (when (and (memq 'Bzr vc-handled-backends) | 3583 | (when (and |
| 3584 | (boundp 'vc-bzr-program) | 3584 | (memq 'Bzr vc-handled-backends) |
| 3585 | (not (with-tramp-connection-property v vc-bzr-program | 3585 | (not (and |
| 3586 | (tramp-find-executable | 3586 | (bound-and-true-p vc-bzr-program) |
| 3587 | v vc-bzr-program (tramp-get-remote-path v))))) | 3587 | (with-tramp-connection-property v vc-bzr-program |
| 3588 | (tramp-find-executable | ||
| 3589 | v vc-bzr-program (tramp-get-remote-path v)))))) | ||
| 3588 | (setq vc-handled-backends (remq 'Bzr vc-handled-backends))) | 3590 | (setq vc-handled-backends (remq 'Bzr vc-handled-backends))) |
| 3589 | (when (and (memq 'Git vc-handled-backends) | 3591 | (when (and |
| 3590 | (boundp 'vc-git-program) | 3592 | (memq 'Git vc-handled-backends) |
| 3591 | (not (with-tramp-connection-property v vc-git-program | 3593 | (not (and |
| 3592 | (tramp-find-executable | 3594 | (bound-and-true-p vc-git-program) |
| 3593 | v vc-git-program (tramp-get-remote-path v))))) | 3595 | (with-tramp-connection-property v vc-git-program |
| 3596 | (tramp-find-executable | ||
| 3597 | v vc-git-program (tramp-get-remote-path v)))))) | ||
| 3594 | (setq vc-handled-backends (remq 'Git vc-handled-backends))) | 3598 | (setq vc-handled-backends (remq 'Git vc-handled-backends))) |
| 3595 | (when (and (memq 'Hg vc-handled-backends) | 3599 | (when (and |
| 3596 | (boundp 'vc-hg-program) | 3600 | (memq 'Hg vc-handled-backends) |
| 3597 | (not (with-tramp-connection-property v vc-hg-program | 3601 | (not (and |
| 3598 | (tramp-find-executable | 3602 | (bound-and-true-p vc-hg-program) |
| 3599 | v vc-hg-program (tramp-get-remote-path v))))) | 3603 | (with-tramp-connection-property v vc-hg-program |
| 3604 | (tramp-find-executable | ||
| 3605 | v vc-hg-program (tramp-get-remote-path v)))))) | ||
| 3600 | (setq vc-handled-backends (remq 'Hg vc-handled-backends))) | 3606 | (setq vc-handled-backends (remq 'Hg vc-handled-backends))) |
| 3601 | ;; Run. | 3607 | ;; Run. |
| 3602 | (tramp-with-demoted-errors | 3608 | (tramp-with-demoted-errors |
| @@ -4290,11 +4296,15 @@ process to set up. VEC specifies the connection." | |||
| 4290 | ;; connection properties. We start again with | 4296 | ;; connection properties. We start again with |
| 4291 | ;; `tramp-maybe-open-connection', it will be caught there. | 4297 | ;; `tramp-maybe-open-connection', it will be caught there. |
| 4292 | (tramp-message vec 5 "Checking system information") | 4298 | (tramp-message vec 5 "Checking system information") |
| 4293 | (let ((old-uname (tramp-get-connection-property vec "uname" nil)) | 4299 | (let* ((old-uname (tramp-get-connection-property vec "uname" nil)) |
| 4294 | (uname | 4300 | (uname |
| 4295 | (tramp-set-connection-property | 4301 | ;; If we are in `make-process', we don't need to recompute. |
| 4296 | vec "uname" | 4302 | (if (and old-uname |
| 4297 | (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) | 4303 | (tramp-get-connection-property vec "process-name" nil)) |
| 4304 | old-uname | ||
| 4305 | (tramp-set-connection-property | ||
| 4306 | vec "uname" | ||
| 4307 | (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))) | ||
| 4298 | (when (and (stringp old-uname) (not (string-equal old-uname uname))) | 4308 | (when (and (stringp old-uname) (not (string-equal old-uname uname))) |
| 4299 | (tramp-message | 4309 | (tramp-message |
| 4300 | vec 3 | 4310 | vec 3 |
| @@ -5053,7 +5063,7 @@ connection if a previous connection has died for some reason." | |||
| 5053 | ;; we cannot use `tramp-get-connection-process'. | 5063 | ;; we cannot use `tramp-get-connection-process'. |
| 5054 | (tmpfile | 5064 | (tmpfile |
| 5055 | (with-tramp-connection-property | 5065 | (with-tramp-connection-property |
| 5056 | (get-process (tramp-buffer-name vec)) "temp-file" | 5066 | (tramp-get-process vec) "temp-file" |
| 5057 | (make-temp-name | 5067 | (make-temp-name |
| 5058 | (expand-file-name | 5068 | (expand-file-name |
| 5059 | tramp-temp-name-prefix | 5069 | tramp-temp-name-prefix |
| @@ -5426,7 +5436,7 @@ Nonexistent directories are removed from spec." | |||
| 5426 | ;; cache the result for the session only. Otherwise, the | 5436 | ;; cache the result for the session only. Otherwise, the |
| 5427 | ;; result is cached persistently. | 5437 | ;; result is cached persistently. |
| 5428 | (if (memq 'tramp-own-remote-path tramp-remote-path) | 5438 | (if (memq 'tramp-own-remote-path tramp-remote-path) |
| 5429 | (tramp-get-connection-process vec) | 5439 | (tramp-get-process vec) |
| 5430 | vec) | 5440 | vec) |
| 5431 | "remote-path" | 5441 | "remote-path" |
| 5432 | (let* ((remote-path (copy-tree tramp-remote-path)) | 5442 | (let* ((remote-path (copy-tree tramp-remote-path)) |
| @@ -5945,10 +5955,9 @@ the length of the file to be compressed. | |||
| 5945 | If no corresponding command is found, nil is returned." | 5955 | If no corresponding command is found, nil is returned." |
| 5946 | (when (and (integerp tramp-inline-compress-start-size) | 5956 | (when (and (integerp tramp-inline-compress-start-size) |
| 5947 | (> size tramp-inline-compress-start-size)) | 5957 | (> size tramp-inline-compress-start-size)) |
| 5948 | (with-tramp-connection-property (tramp-get-connection-process vec) prop | 5958 | (with-tramp-connection-property (tramp-get-process vec) prop |
| 5949 | (tramp-find-inline-compress vec) | 5959 | (tramp-find-inline-compress vec) |
| 5950 | (tramp-get-connection-property | 5960 | (tramp-get-connection-property (tramp-get-process vec) prop nil)))) |
| 5951 | (tramp-get-connection-process vec) prop nil)))) | ||
| 5952 | 5961 | ||
| 5953 | (defun tramp-get-inline-coding (vec prop size) | 5962 | (defun tramp-get-inline-coding (vec prop size) |
| 5954 | "Return the coding command related to PROP. | 5963 | "Return the coding command related to PROP. |
| @@ -5966,11 +5975,9 @@ function cell is returned to be applied on a buffer." | |||
| 5966 | ;; no inline coding is found. | 5975 | ;; no inline coding is found. |
| 5967 | (ignore-errors | 5976 | (ignore-errors |
| 5968 | (let ((coding | 5977 | (let ((coding |
| 5969 | (with-tramp-connection-property | 5978 | (with-tramp-connection-property (tramp-get-process vec) prop |
| 5970 | (tramp-get-connection-process vec) prop | ||
| 5971 | (tramp-find-inline-encoding vec) | 5979 | (tramp-find-inline-encoding vec) |
| 5972 | (tramp-get-connection-property | 5980 | (tramp-get-connection-property (tramp-get-process vec) prop nil))) |
| 5973 | (tramp-get-connection-process vec) prop nil))) | ||
| 5974 | (prop1 (if (string-match-p "encoding" prop) | 5981 | (prop1 (if (string-match-p "encoding" prop) |
| 5975 | "inline-compress" "inline-decompress")) | 5982 | "inline-compress" "inline-decompress")) |
| 5976 | compress) | 5983 | compress) |
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index effac333dad..d361db483a1 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el | |||
| @@ -1557,9 +1557,6 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." | |||
| 1557 | (format "File %s exists; overwrite anyway? " filename))))) | 1557 | (format "File %s exists; overwrite anyway? " filename))))) |
| 1558 | (tramp-error v 'file-already-exists filename)) | 1558 | (tramp-error v 'file-already-exists filename)) |
| 1559 | 1559 | ||
| 1560 | ;; We must also flush the cache of the directory, because | ||
| 1561 | ;; `file-attributes' reads the values from there. | ||
| 1562 | (tramp-flush-file-properties v localname) | ||
| 1563 | (let ((curbuf (current-buffer)) | 1560 | (let ((curbuf (current-buffer)) |
| 1564 | (tmpfile (tramp-compat-make-temp-file filename))) | 1561 | (tmpfile (tramp-compat-make-temp-file filename))) |
| 1565 | (when (and append (file-exists-p filename)) | 1562 | (when (and append (file-exists-p filename)) |
| @@ -1579,6 +1576,10 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." | |||
| 1579 | (tramp-error v 'file-error "Cannot write `%s'" filename)) | 1576 | (tramp-error v 'file-error "Cannot write `%s'" filename)) |
| 1580 | (delete-file tmpfile))) | 1577 | (delete-file tmpfile))) |
| 1581 | 1578 | ||
| 1579 | ;; We must also flush the cache of the directory, because | ||
| 1580 | ;; `file-attributes' reads the values from there. | ||
| 1581 | (tramp-flush-file-properties v localname) | ||
| 1582 | |||
| 1582 | (unless (equal curbuf (current-buffer)) | 1583 | (unless (equal curbuf (current-buffer)) |
| 1583 | (tramp-error | 1584 | (tramp-error |
| 1584 | v 'file-error | 1585 | v 'file-error |
| @@ -1844,7 +1845,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." | |||
| 1844 | (if (and (process-live-p (tramp-get-connection-process vec)) | 1845 | (if (and (process-live-p (tramp-get-connection-process vec)) |
| 1845 | (tramp-get-connection-property vec "posix" t)) | 1846 | (tramp-get-connection-property vec "posix" t)) |
| 1846 | (with-tramp-connection-property | 1847 | (with-tramp-connection-property |
| 1847 | (tramp-get-connection-process vec) "cifs-capabilities" | 1848 | (tramp-get-process vec) "cifs-capabilities" |
| 1848 | (save-match-data | 1849 | (save-match-data |
| 1849 | (when (tramp-smb-send-command vec "posix") | 1850 | (when (tramp-smb-send-command vec "posix") |
| 1850 | (with-current-buffer (tramp-get-connection-buffer vec) | 1851 | (with-current-buffer (tramp-get-connection-buffer vec) |
| @@ -1861,8 +1862,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." | |||
| 1861 | ;; When we are not logged in yet, we return nil. | 1862 | ;; When we are not logged in yet, we return nil. |
| 1862 | (if (and (tramp-smb-get-share vec) | 1863 | (if (and (tramp-smb-get-share vec) |
| 1863 | (process-live-p (tramp-get-connection-process vec))) | 1864 | (process-live-p (tramp-get-connection-process vec))) |
| 1864 | (with-tramp-connection-property | 1865 | (with-tramp-connection-property (tramp-get-process vec) "stat-capability" |
| 1865 | (tramp-get-connection-process vec) "stat-capability" | ||
| 1866 | (tramp-smb-send-command vec "stat \"/\"")))) | 1866 | (tramp-smb-send-command vec "stat \"/\"")))) |
| 1867 | 1867 | ||
| 1868 | 1868 | ||
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index b6861ba7882..68e68a242c9 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el | |||
| @@ -373,7 +373,7 @@ the result will be a local, non-Tramp, file name." | |||
| 373 | 373 | ||
| 374 | (defun tramp-sudoedit-remote-acl-p (vec) | 374 | (defun tramp-sudoedit-remote-acl-p (vec) |
| 375 | "Check, whether ACL is enabled on the remote host." | 375 | "Check, whether ACL is enabled on the remote host." |
| 376 | (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p" | 376 | (with-tramp-connection-property (tramp-get-process vec) "acl-p" |
| 377 | (zerop (tramp-call-process vec "getfacl" nil nil nil "/")))) | 377 | (zerop (tramp-call-process vec "getfacl" nil nil nil "/")))) |
| 378 | 378 | ||
| 379 | (defun tramp-sudoedit-handle-file-acl (filename) | 379 | (defun tramp-sudoedit-handle-file-acl (filename) |
| @@ -478,7 +478,7 @@ the result will be a local, non-Tramp, file name." | |||
| 478 | 478 | ||
| 479 | (defun tramp-sudoedit-remote-selinux-p (vec) | 479 | (defun tramp-sudoedit-remote-selinux-p (vec) |
| 480 | "Check, whether SELINUX is enabled on the remote host." | 480 | "Check, whether SELINUX is enabled on the remote host." |
| 481 | (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p" | 481 | (with-tramp-connection-property (tramp-get-process vec) "selinux-p" |
| 482 | (zerop (tramp-call-process vec "selinuxenabled")))) | 482 | (zerop (tramp-call-process vec "selinuxenabled")))) |
| 483 | 483 | ||
| 484 | (defun tramp-sudoedit-handle-file-selinux-context (filename) | 484 | (defun tramp-sudoedit-handle-file-selinux-context (filename) |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3ce2225cb84..e30f27fd338 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -37,7 +37,7 @@ | |||
| 37 | ;; For more detailed instructions, please see the info file. | 37 | ;; For more detailed instructions, please see the info file. |
| 38 | ;; | 38 | ;; |
| 39 | ;; Notes: | 39 | ;; Notes: |
| 40 | ;; ----- | 40 | ;; ------ |
| 41 | ;; | 41 | ;; |
| 42 | ;; Also see the todo list at the bottom of this file. | 42 | ;; Also see the todo list at the bottom of this file. |
| 43 | ;; | 43 | ;; |
| @@ -46,6 +46,7 @@ | |||
| 46 | ;; | 46 | ;; |
| 47 | ;; There's a mailing list for this, as well. Its name is: | 47 | ;; There's a mailing list for this, as well. Its name is: |
| 48 | ;; tramp-devel@gnu.org | 48 | ;; tramp-devel@gnu.org |
| 49 | |||
| 49 | ;; You can use the Web to subscribe, under the following URL: | 50 | ;; You can use the Web to subscribe, under the following URL: |
| 50 | ;; https://lists.gnu.org/mailman/listinfo/tramp-devel | 51 | ;; https://lists.gnu.org/mailman/listinfo/tramp-devel |
| 51 | ;; | 52 | ;; |
| @@ -1631,6 +1632,15 @@ from the default one." | |||
| 1631 | (or (tramp-get-connection-property vec "process-name" nil) | 1632 | (or (tramp-get-connection-property vec "process-name" nil) |
| 1632 | (tramp-buffer-name vec))) | 1633 | (tramp-buffer-name vec))) |
| 1633 | 1634 | ||
| 1635 | (defun tramp-get-process (vec-or-proc) | ||
| 1636 | "Get the default connection process to be used for VEC-OR-PROC. | ||
| 1637 | Return `tramp-cache-undefined' in case it doesn't exist." | ||
| 1638 | (or (and (tramp-file-name-p vec-or-proc) | ||
| 1639 | (get-buffer-process (tramp-buffer-name vec-or-proc))) | ||
| 1640 | (and (processp vec-or-proc) | ||
| 1641 | (tramp-get-process (process-get vec-or-proc 'vector))) | ||
| 1642 | tramp-cache-undefined)) | ||
| 1643 | |||
| 1634 | (defun tramp-get-connection-process (vec) | 1644 | (defun tramp-get-connection-process (vec) |
| 1635 | "Get the connection process to be used for VEC. | 1645 | "Get the connection process to be used for VEC. |
| 1636 | In case a second asynchronous communication has been started, it is different | 1646 | In case a second asynchronous communication has been started, it is different |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 455f181f501..e5878b28f96 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -646,6 +646,16 @@ matched file names, and weeding out false positives." | |||
| 646 | :link `(file-link :tag "example file" | 646 | :link `(file-link :tag "example file" |
| 647 | ,(expand-file-name "compilation.txt" data-directory))) | 647 | ,(expand-file-name "compilation.txt" data-directory))) |
| 648 | 648 | ||
| 649 | (defvar compilation-error-case-fold-search nil | ||
| 650 | "If non-nil, use case-insensitive matching of compilation errors | ||
| 651 | by the regexps of `compilation-error-regexp-alist' and | ||
| 652 | `compilation-error-regexp-alist-alist'. | ||
| 653 | If nil, matching is case-sensitive. | ||
| 654 | |||
| 655 | This variable should only be set for backward compatibility as a temporary | ||
| 656 | measure. The proper solution is to use a regexp that matches the | ||
| 657 | messages without case-folding.") | ||
| 658 | |||
| 649 | ;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp) | 659 | ;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp) |
| 650 | (defvar compilation-directory nil | 660 | (defvar compilation-directory nil |
| 651 | "Directory to restore to when doing `recompile'.") | 661 | "Directory to restore to when doing `recompile'.") |
| @@ -1435,7 +1445,8 @@ to `compilation-error-regexp-alist' if RULES is nil." | |||
| 1435 | (if (symbolp item) | 1445 | (if (symbolp item) |
| 1436 | (setq item (cdr (assq item | 1446 | (setq item (cdr (assq item |
| 1437 | compilation-error-regexp-alist-alist)))) | 1447 | compilation-error-regexp-alist-alist)))) |
| 1438 | (let ((file (nth 1 item)) | 1448 | (let ((case-fold-search compilation-error-case-fold-search) |
| 1449 | (file (nth 1 item)) | ||
| 1439 | (line (nth 2 item)) | 1450 | (line (nth 2 item)) |
| 1440 | (col (nth 3 item)) | 1451 | (col (nth 3 item)) |
| 1441 | (type (nth 4 item)) | 1452 | (type (nth 4 item)) |
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index bb780259333..1c9e805f039 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el | |||
| @@ -34,6 +34,7 @@ | |||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | 35 | ||
| 36 | (require 'cl-lib) | 36 | (require 'cl-lib) |
| 37 | (require 'seq) | ||
| 37 | (require 'easymenu) | 38 | (require 'easymenu) |
| 38 | (require 'view) | 39 | (require 'view) |
| 39 | (require 'ebuff-menu) | 40 | (require 'ebuff-menu) |
| @@ -52,32 +53,27 @@ | |||
| 52 | "List of directories to search for source files in a class tree. | 53 | "List of directories to search for source files in a class tree. |
| 53 | Elements should be directory names; nil as an element means to try | 54 | Elements should be directory names; nil as an element means to try |
| 54 | to find source files relative to the location of the BROWSE file loaded." | 55 | to find source files relative to the location of the BROWSE file loaded." |
| 55 | :group 'ebrowse | ||
| 56 | :type '(repeat (choice (const :tag "Default" nil) | 56 | :type '(repeat (choice (const :tag "Default" nil) |
| 57 | (string :tag "Directory")))) | 57 | (string :tag "Directory")))) |
| 58 | 58 | ||
| 59 | 59 | ||
| 60 | (defcustom ebrowse-view/find-hook nil | 60 | (defcustom ebrowse-view/find-hook nil |
| 61 | "Hooks run after finding or viewing a member or class." | 61 | "Hooks run after finding or viewing a member or class." |
| 62 | :group 'ebrowse | ||
| 63 | :type 'hook) | 62 | :type 'hook) |
| 64 | 63 | ||
| 65 | 64 | ||
| 66 | (defcustom ebrowse-not-found-hook nil | 65 | (defcustom ebrowse-not-found-hook nil |
| 67 | "Hooks run when finding or viewing a member or class was not successful." | 66 | "Hooks run when finding or viewing a member or class was not successful." |
| 68 | :group 'ebrowse | ||
| 69 | :type 'hook) | 67 | :type 'hook) |
| 70 | 68 | ||
| 71 | 69 | ||
| 72 | (defcustom ebrowse-electric-list-mode-hook nil | 70 | (defcustom ebrowse-electric-list-mode-hook nil |
| 73 | "Hook called by `ebrowse-electric-position-mode'." | 71 | "Hook called by `ebrowse-electric-position-mode'." |
| 74 | :group 'ebrowse | ||
| 75 | :type 'hook) | 72 | :type 'hook) |
| 76 | 73 | ||
| 77 | 74 | ||
| 78 | (defcustom ebrowse-max-positions 50 | 75 | (defcustom ebrowse-max-positions 50 |
| 79 | "Number of markers saved on electric position stack." | 76 | "Number of markers saved on electric position stack." |
| 80 | :group 'ebrowse | ||
| 81 | :type 'integer) | 77 | :type 'integer) |
| 82 | 78 | ||
| 83 | 79 | ||
| @@ -89,32 +85,27 @@ to find source files relative to the location of the BROWSE file loaded." | |||
| 89 | 85 | ||
| 90 | (defcustom ebrowse-tree-mode-hook nil | 86 | (defcustom ebrowse-tree-mode-hook nil |
| 91 | "Hook run in each new tree buffer." | 87 | "Hook run in each new tree buffer." |
| 92 | :group 'ebrowse-tree | ||
| 93 | :type 'hook) | 88 | :type 'hook) |
| 94 | 89 | ||
| 95 | 90 | ||
| 96 | (defcustom ebrowse-tree-buffer-name "*Tree*" | 91 | (defcustom ebrowse-tree-buffer-name "*Tree*" |
| 97 | "The default name of class tree buffers." | 92 | "The default name of class tree buffers." |
| 98 | :group 'ebrowse-tree | ||
| 99 | :type 'string) | 93 | :type 'string) |
| 100 | 94 | ||
| 101 | 95 | ||
| 102 | (defcustom ebrowse--indentation 4 | 96 | (defcustom ebrowse--indentation 4 |
| 103 | "The amount by which subclasses are indented in the tree." | 97 | "The amount by which subclasses are indented in the tree." |
| 104 | :group 'ebrowse-tree | ||
| 105 | :type 'integer) | 98 | :type 'integer) |
| 106 | 99 | ||
| 107 | 100 | ||
| 108 | (defcustom ebrowse-source-file-column 40 | 101 | (defcustom ebrowse-source-file-column 40 |
| 109 | "The column in which source file names are displayed in the tree." | 102 | "The column in which source file names are displayed in the tree." |
| 110 | :group 'ebrowse-tree | ||
| 111 | :type 'integer) | 103 | :type 'integer) |
| 112 | 104 | ||
| 113 | 105 | ||
| 114 | (defcustom ebrowse-tree-left-margin 2 | 106 | (defcustom ebrowse-tree-left-margin 2 |
| 115 | "Amount of space left at the left side of the tree display. | 107 | "Amount of space left at the left side of the tree display. |
| 116 | This space is used to display markers." | 108 | This space is used to display markers." |
| 117 | :group 'ebrowse-tree | ||
| 118 | :type 'integer) | 109 | :type 'integer) |
| 119 | 110 | ||
| 120 | 111 | ||
| @@ -126,25 +117,21 @@ This space is used to display markers." | |||
| 126 | 117 | ||
| 127 | (defcustom ebrowse-default-declaration-column 25 | 118 | (defcustom ebrowse-default-declaration-column 25 |
| 128 | "The column in which member declarations are displayed in member buffers." | 119 | "The column in which member declarations are displayed in member buffers." |
| 129 | :group 'ebrowse-member | ||
| 130 | :type 'integer) | 120 | :type 'integer) |
| 131 | 121 | ||
| 132 | 122 | ||
| 133 | (defcustom ebrowse-default-column-width 25 | 123 | (defcustom ebrowse-default-column-width 25 |
| 134 | "The width of the columns in member buffers (short display form)." | 124 | "The width of the columns in member buffers (short display form)." |
| 135 | :group 'ebrowse-member | ||
| 136 | :type 'integer) | 125 | :type 'integer) |
| 137 | 126 | ||
| 138 | 127 | ||
| 139 | (defcustom ebrowse-member-buffer-name "*Members*" | 128 | (defcustom ebrowse-member-buffer-name "*Members*" |
| 140 | "The name of the buffer for member display." | 129 | "The name of the buffer for member display." |
| 141 | :group 'ebrowse-member | ||
| 142 | :type 'string) | 130 | :type 'string) |
| 143 | 131 | ||
| 144 | 132 | ||
| 145 | (defcustom ebrowse-member-mode-hook nil | 133 | (defcustom ebrowse-member-mode-hook nil |
| 146 | "Run in each new member buffer." | 134 | "Run in each new member buffer." |
| 147 | :group 'ebrowse-member | ||
| 148 | :type 'hook) | 135 | :type 'hook) |
| 149 | 136 | ||
| 150 | 137 | ||
| @@ -156,81 +143,47 @@ This space is used to display markers." | |||
| 156 | (defface ebrowse-tree-mark | 143 | (defface ebrowse-tree-mark |
| 157 | '((((min-colors 88)) :foreground "red1") | 144 | '((((min-colors 88)) :foreground "red1") |
| 158 | (t :foreground "red")) | 145 | (t :foreground "red")) |
| 159 | "Face for the mark character in the Ebrowse tree." | 146 | "Face for the mark character in the Ebrowse tree.") |
| 160 | :group 'ebrowse-faces) | ||
| 161 | 147 | ||
| 162 | (defface ebrowse-root-class | 148 | (defface ebrowse-root-class |
| 163 | '((((min-colors 88)) :weight bold :foreground "blue1") | 149 | '((((min-colors 88)) :weight bold :foreground "blue1") |
| 164 | (t :weight bold :foreground "blue")) | 150 | (t :weight bold :foreground "blue")) |
| 165 | "Face for root classes in the Ebrowse tree." | 151 | "Face for root classes in the Ebrowse tree.") |
| 166 | :group 'ebrowse-faces) | ||
| 167 | 152 | ||
| 168 | (defface ebrowse-file-name '((t :slant italic)) | 153 | (defface ebrowse-file-name '((t :slant italic)) |
| 169 | "Face for filenames in the Ebrowse tree." | 154 | "Face for filenames in the Ebrowse tree.") |
| 170 | :group 'ebrowse-faces) | ||
| 171 | 155 | ||
| 172 | (defface ebrowse-default '((t)) | 156 | (defface ebrowse-default '((t)) |
| 173 | "Face for items in the Ebrowse tree which do not have other faces." | 157 | "Face for items in the Ebrowse tree which do not have other faces.") |
| 174 | :group 'ebrowse-faces) | ||
| 175 | 158 | ||
| 176 | (defface ebrowse-member-attribute | 159 | (defface ebrowse-member-attribute |
| 177 | '((((min-colors 88)) :foreground "red1") | 160 | '((((min-colors 88)) :foreground "red1") |
| 178 | (t :foreground "red")) | 161 | (t :foreground "red")) |
| 179 | "Face for member attributes." | 162 | "Face for member attributes.") |
| 180 | :group 'ebrowse-faces) | ||
| 181 | 163 | ||
| 182 | (defface ebrowse-member-class | 164 | (defface ebrowse-member-class |
| 183 | '((t :foreground "purple")) | 165 | '((t :foreground "purple")) |
| 184 | "Face used to display the class title in member buffers." | 166 | "Face used to display the class title in member buffers.") |
| 185 | :group 'ebrowse-faces) | ||
| 186 | 167 | ||
| 187 | (defface ebrowse-progress | 168 | (defface ebrowse-progress |
| 188 | '((((min-colors 88)) :background "blue1") | 169 | '((((min-colors 88)) :background "blue1") |
| 189 | (t :background "blue")) | 170 | (t :background "blue")) |
| 190 | "Face for progress indicator." | 171 | "Face for progress indicator.") |
| 191 | :group 'ebrowse-faces) | ||
| 192 | 172 | ||
| 193 | 173 | ||
| 194 | ;;; Utilities. | 174 | ;;; Utilities. |
| 195 | 175 | ||
| 196 | (defun ebrowse-some (predicate vector) | 176 | (define-obsolete-function-alias 'ebrowse-some #'seq-some "28.1") |
| 197 | "Return true if PREDICATE is true of some element of VECTOR. | ||
| 198 | If so, return the value returned by PREDICATE." | ||
| 199 | (let ((length (length vector)) | ||
| 200 | (i 0) | ||
| 201 | result) | ||
| 202 | (while (and (< i length) (not result)) | ||
| 203 | (setq result (funcall predicate (aref vector i)) | ||
| 204 | i (1+ i))) | ||
| 205 | result)) | ||
| 206 | 177 | ||
| 207 | 178 | ||
| 208 | (defun ebrowse-every (predicate vector) | 179 | (define-obsolete-function-alias 'ebrowse-every #'seq-every-p "28.1") |
| 209 | "Return true if PREDICATE is true of every element of VECTOR." | ||
| 210 | (let ((length (length vector)) | ||
| 211 | (i 0) | ||
| 212 | (result t)) | ||
| 213 | (while (and (< i length) result) | ||
| 214 | (setq result (funcall predicate (aref vector i)) | ||
| 215 | i (1+ i))) | ||
| 216 | result)) | ||
| 217 | 180 | ||
| 218 | 181 | ||
| 219 | (defun ebrowse-position (item list &optional test) | 182 | (defun ebrowse-position (item list &optional test) |
| 220 | "Return the position of ITEM in LIST or nil if not found. | 183 | "Return the position of ITEM in LIST or nil if not found. |
| 221 | Compare items with `eq' or TEST if specified." | 184 | Compare items with `eq' or TEST if specified." |
| 222 | (let ((i 0) found) | 185 | (declare (obsolete seq-position "28.1")) |
| 223 | (cond (test | 186 | (seq-position list item (or test #'eql))) |
| 224 | (while list | ||
| 225 | (when (funcall test item (car list)) | ||
| 226 | (setq found i list nil)) | ||
| 227 | (setq list (cdr list) i (1+ i)))) | ||
| 228 | (t | ||
| 229 | (while list | ||
| 230 | (when (eq item (car list)) | ||
| 231 | (setq found i list nil)) | ||
| 232 | (setq list (cdr list) i (1+ i))))) | ||
| 233 | found)) | ||
| 234 | 187 | ||
| 235 | 188 | ||
| 236 | (defmacro ebrowse-ignoring-completion-case (&rest body) | 189 | (defmacro ebrowse-ignoring-completion-case (&rest body) |
| @@ -242,17 +195,13 @@ Compare items with `eq' or TEST if specified." | |||
| 242 | (defmacro ebrowse-for-all-trees (spec &rest body) | 195 | (defmacro ebrowse-for-all-trees (spec &rest body) |
| 243 | "For all trees in SPEC, eval BODY." | 196 | "For all trees in SPEC, eval BODY." |
| 244 | (declare (indent 1) (debug ((sexp form) body))) | 197 | (declare (indent 1) (debug ((sexp form) body))) |
| 245 | (let ((var (make-symbol "var")) | 198 | (let ((spec-var (car spec)) |
| 246 | (spec-var (car spec)) | ||
| 247 | (array (cadr spec))) | 199 | (array (cadr spec))) |
| 248 | `(cl-loop for ,var being the symbols of ,array | 200 | `(maphash (lambda (_k ,spec-var) |
| 249 | as ,spec-var = (get ,var 'ebrowse-root) do | 201 | (when ,spec-var |
| 250 | (when (vectorp ,spec-var) | 202 | (cl-assert (cl-typep ,spec-var 'ebrowse-ts)) |
| 251 | ,@body)))) | 203 | ,@body)) |
| 252 | 204 | ,array))) | |
| 253 | ;;; Set indentation for macros above. | ||
| 254 | |||
| 255 | |||
| 256 | 205 | ||
| 257 | (defsubst ebrowse-set-face (start end face) | 206 | (defsubst ebrowse-set-face (start end face) |
| 258 | "Set face of a region START END to FACE." | 207 | "Set face of a region START END to FACE." |
| @@ -264,8 +213,7 @@ Compare items with `eq' or TEST if specified." | |||
| 264 | Case is ignored in completions. | 213 | Case is ignored in completions. |
| 265 | 214 | ||
| 266 | PROMPT is a string to prompt with; normally it ends in a colon and a space. | 215 | PROMPT is a string to prompt with; normally it ends in a colon and a space. |
| 267 | TABLE is an alist whose elements' cars are strings, or an obarray. | 216 | TABLE is a completion table. |
| 268 | TABLE can also be a function to do the completion itself. | ||
| 269 | If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. | 217 | If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. |
| 270 | If it is (STRING . POSITION), the initial input | 218 | If it is (STRING . POSITION), the initial input |
| 271 | is STRING, but point is placed POSITION characters into the string." | 219 | is STRING, but point is placed POSITION characters into the string." |
| @@ -304,6 +252,9 @@ otherwise use the current frame's width." | |||
| 304 | 252 | ||
| 305 | ;;; Structure definitions | 253 | ;;; Structure definitions |
| 306 | 254 | ||
| 255 | ;; Note: These use `(:type vector) :named' in order to match the | ||
| 256 | ;; format used in src/BROWSE. | ||
| 257 | |||
| 307 | (cl-defstruct (ebrowse-hs (:type vector) :named) | 258 | (cl-defstruct (ebrowse-hs (:type vector) :named) |
| 308 | "Header structure found at the head of BROWSE files." | 259 | "Header structure found at the head of BROWSE files." |
| 309 | ;; A version string that is compared against the version number of | 260 | ;; A version string that is compared against the version number of |
| @@ -457,19 +408,17 @@ members." | |||
| 457 | This must be the same that `ebrowse' uses.") | 408 | This must be the same that `ebrowse' uses.") |
| 458 | 409 | ||
| 459 | 410 | ||
| 460 | (defvar ebrowse--last-regexp nil | 411 | (defvar-local ebrowse--last-regexp nil |
| 461 | "Last regular expression searched for in tree and member buffers. | 412 | "Last regular expression searched for in tree and member buffers. |
| 462 | Each tree and member buffer maintains its own search history.") | 413 | Each tree and member buffer maintains its own search history.") |
| 463 | (make-variable-buffer-local 'ebrowse--last-regexp) | ||
| 464 | |||
| 465 | 414 | ||
| 466 | (defconst ebrowse-member-list-accessors | 415 | (defconst ebrowse-member-list-accessors |
| 467 | '(ebrowse-ts-member-variables | 416 | (list #'ebrowse-ts-member-variables |
| 468 | ebrowse-ts-member-functions | 417 | #'ebrowse-ts-member-functions |
| 469 | ebrowse-ts-static-variables | 418 | #'ebrowse-ts-static-variables |
| 470 | ebrowse-ts-static-functions | 419 | #'ebrowse-ts-static-functions |
| 471 | ebrowse-ts-friends | 420 | #'ebrowse-ts-friends |
| 472 | ebrowse-ts-types) | 421 | #'ebrowse-ts-types) |
| 473 | "List of accessors for member lists. | 422 | "List of accessors for member lists. |
| 474 | Each element is the symbol of an accessor function. | 423 | Each element is the symbol of an accessor function. |
| 475 | The nth element must be the accessor for the nth member list | 424 | The nth element must be the accessor for the nth member list |
| @@ -478,8 +427,8 @@ in an `ebrowse-ts' structure.") | |||
| 478 | 427 | ||
| 479 | ;;; FIXME: Add more doc strings for the buffer-local variables below. | 428 | ;;; FIXME: Add more doc strings for the buffer-local variables below. |
| 480 | 429 | ||
| 481 | (defvar ebrowse--tree-obarray nil | 430 | (defvar ebrowse--tree-table nil |
| 482 | "Obarray holding all `ebrowse-ts' structures of a class tree. | 431 | "Hash-table holding all `ebrowse-ts' structures of a class tree. |
| 483 | Buffer-local in Ebrowse buffers.") | 432 | Buffer-local in Ebrowse buffers.") |
| 484 | 433 | ||
| 485 | 434 | ||
| @@ -637,12 +586,12 @@ Buffer-local in Ebrowse buffers.") | |||
| 637 | ;;; Operations on `ebrowse-ts' structures | 586 | ;;; Operations on `ebrowse-ts' structures |
| 638 | 587 | ||
| 639 | (defun ebrowse-files-table (&optional marked-only) | 588 | (defun ebrowse-files-table (&optional marked-only) |
| 640 | "Return an obarray containing all files mentioned in the current tree. | 589 | "Return a hash table containing all files mentioned in the current tree. |
| 641 | The tree is expected in the buffer-local variable `ebrowse--tree-obarray'. | 590 | The tree is expected in the buffer-local variable `ebrowse--tree-table'. |
| 642 | MARKED-ONLY non-nil means include marked classes only." | 591 | MARKED-ONLY non-nil means include marked classes only." |
| 643 | (let ((files (make-hash-table :test 'equal)) | 592 | (let ((files (make-hash-table :test 'equal)) |
| 644 | (i -1)) | 593 | (i -1)) |
| 645 | (ebrowse-for-all-trees (tree ebrowse--tree-obarray) | 594 | (ebrowse-for-all-trees (tree ebrowse--tree-table) |
| 646 | (when (or (not marked-only) (ebrowse-ts-mark tree)) | 595 | (when (or (not marked-only) (ebrowse-ts-mark tree)) |
| 647 | (let ((class (ebrowse-ts-class tree))) | 596 | (let ((class (ebrowse-ts-class tree))) |
| 648 | (when (zerop (% (cl-incf i) 20)) | 597 | (when (zerop (% (cl-incf i) 20)) |
| @@ -677,7 +626,7 @@ MARKED-ONLY non-nil means include marked classes only." | |||
| 677 | 626 | ||
| 678 | (cl-defun ebrowse-marked-classes-p () | 627 | (cl-defun ebrowse-marked-classes-p () |
| 679 | "Value is non-nil if any class in the current class tree is marked." | 628 | "Value is non-nil if any class in the current class tree is marked." |
| 680 | (ebrowse-for-all-trees (tree ebrowse--tree-obarray) | 629 | (ebrowse-for-all-trees (tree ebrowse--tree-table) |
| 681 | (when (ebrowse-ts-mark tree) | 630 | (when (ebrowse-ts-mark tree) |
| 682 | (cl-return-from ebrowse-marked-classes-p tree)))) | 631 | (cl-return-from ebrowse-marked-classes-p tree)))) |
| 683 | 632 | ||
| @@ -695,21 +644,21 @@ MARKED-ONLY non-nil means include marked classes only." | |||
| 695 | (ebrowse-cs-name class))) | 644 | (ebrowse-cs-name class))) |
| 696 | 645 | ||
| 697 | 646 | ||
| 698 | (defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p) | 647 | (defun ebrowse-tree-table-as-alist (&optional qualified-names-p) |
| 699 | "Return an alist describing all classes in a tree. | 648 | "Return an alist describing all classes in a tree. |
| 700 | Each elements in the list has the form (CLASS-NAME . TREE). | 649 | Each elements in the list has the form (CLASS-NAME . TREE). |
| 701 | CLASS-NAME is the name of the class. TREE is the | 650 | CLASS-NAME is the name of the class. TREE is the |
| 702 | class tree whose root is QUALIFIED-CLASS-NAME. | 651 | class tree whose root is QUALIFIED-CLASS-NAME. |
| 703 | QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME. | 652 | QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME. |
| 704 | The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." | 653 | The class tree is found in the buffer-local variable `ebrowse--tree-table'." |
| 705 | (let (alist) | 654 | (let (alist) |
| 706 | (if qualified-names-p | 655 | (if qualified-names-p |
| 707 | (ebrowse-for-all-trees (tree ebrowse--tree-obarray) | 656 | (ebrowse-for-all-trees (tree ebrowse--tree-table) |
| 708 | (setq alist | 657 | (setq alist |
| 709 | (cl-acons (ebrowse-qualified-class-name | 658 | (cl-acons (ebrowse-qualified-class-name |
| 710 | (ebrowse-ts-class tree)) | 659 | (ebrowse-ts-class tree)) |
| 711 | tree alist))) | 660 | tree alist))) |
| 712 | (ebrowse-for-all-trees (tree ebrowse--tree-obarray) | 661 | (ebrowse-for-all-trees (tree ebrowse--tree-table) |
| 713 | (setq alist | 662 | (setq alist |
| 714 | (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree)) | 663 | (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree)) |
| 715 | tree alist)))) | 664 | tree alist)))) |
| @@ -751,7 +700,7 @@ computes this information lazily." | |||
| 751 | with result = nil | 700 | with result = nil |
| 752 | as search = (pop to-search) | 701 | as search = (pop to-search) |
| 753 | while search finally return result | 702 | while search finally return result |
| 754 | do (ebrowse-for-all-trees (ti ebrowse--tree-obarray) | 703 | do (ebrowse-for-all-trees (ti ebrowse--tree-table) |
| 755 | (when (memq search (ebrowse-ts-subclasses ti)) | 704 | (when (memq search (ebrowse-ts-subclasses ti)) |
| 756 | (unless (memq ti result) | 705 | (unless (memq ti result) |
| 757 | (setq result (nconc result (list ti)))) | 706 | (setq result (nconc result (list ti)))) |
| @@ -875,7 +824,7 @@ NOCONFIRM." | |||
| 875 | "Create a new tree buffer for tree TREE. | 824 | "Create a new tree buffer for tree TREE. |
| 876 | The tree was loaded from file TAGS-FILE. | 825 | The tree was loaded from file TAGS-FILE. |
| 877 | HEADER is the header structure of the file. | 826 | HEADER is the header structure of the file. |
| 878 | CLASSES is an obarray with a symbol for each class in the tree. | 827 | CLASSES is a hash-table with an entry for each class in the tree. |
| 879 | POP non-nil means popup the buffer up at the end. | 828 | POP non-nil means popup the buffer up at the end. |
| 880 | Return the buffer created." | 829 | Return the buffer created." |
| 881 | (let ((name ebrowse-tree-buffer-name)) | 830 | (let ((name ebrowse-tree-buffer-name)) |
| @@ -883,7 +832,7 @@ Return the buffer created." | |||
| 883 | (ebrowse-tree-mode) | 832 | (ebrowse-tree-mode) |
| 884 | (setq ebrowse--tree tree | 833 | (setq ebrowse--tree tree |
| 885 | ebrowse--tags-file-name tags-file | 834 | ebrowse--tags-file-name tags-file |
| 886 | ebrowse--tree-obarray classes | 835 | ebrowse--tree-table classes |
| 887 | ebrowse--header header | 836 | ebrowse--header header |
| 888 | ebrowse--frozen-flag nil) | 837 | ebrowse--frozen-flag nil) |
| 889 | (ebrowse-redraw-tree) | 838 | (ebrowse-redraw-tree) |
| @@ -895,13 +844,13 @@ Return the buffer created." | |||
| 895 | 844 | ||
| 896 | 845 | ||
| 897 | 846 | ||
| 898 | ;;; Operations for member obarrays | 847 | ;;; Operations for member tables |
| 899 | 848 | ||
| 900 | (defun ebrowse-fill-member-table () | 849 | (defun ebrowse-fill-member-table () |
| 901 | "Return an obarray holding all members of all classes in the current tree. | 850 | "Return a hash table holding all members of all classes in the current tree. |
| 902 | 851 | ||
| 903 | For each member, a symbol is added to the obarray. Members are | 852 | For each member, a symbol is added to the table. Members are |
| 904 | extracted from the buffer-local tree `ebrowse--tree-obarray'. | 853 | extracted from the buffer-local tree `ebrowse--tree-table'. |
| 905 | 854 | ||
| 906 | Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST | 855 | Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST |
| 907 | MEMBER) where TREE is the tree in which the member is defined, | 856 | MEMBER) where TREE is the tree in which the member is defined, |
| @@ -909,26 +858,23 @@ MEMBER-LIST is a symbol describing the member list in which the member | |||
| 909 | is found, and MEMBER is a MEMBER structure describing the member. | 858 | is found, and MEMBER is a MEMBER structure describing the member. |
| 910 | 859 | ||
| 911 | The slot `member-table' of the buffer-local header structure of | 860 | The slot `member-table' of the buffer-local header structure of |
| 912 | type `ebrowse-hs' is set to the resulting obarray." | 861 | type `ebrowse-hs' is set to the resulting table." |
| 913 | (let ((members (make-hash-table :test 'equal)) | 862 | (let ((members (make-hash-table :test 'equal)) |
| 914 | (i -1)) | 863 | (i -1)) |
| 915 | (setf (ebrowse-hs-member-table ebrowse--header) nil) | 864 | (setf (ebrowse-hs-member-table ebrowse--header) nil) |
| 916 | (garbage-collect) | 865 | (garbage-collect) |
| 917 | ;; For all classes... | 866 | ;; For all classes... |
| 918 | (ebrowse-for-all-trees (c ebrowse--tree-obarray) | 867 | (ebrowse-for-all-trees (c ebrowse--tree-table) |
| 919 | (when (zerop (% (cl-incf i) 10)) | 868 | (when (zerop (% (cl-incf i) 10)) |
| 920 | (ebrowse-show-progress "Preparing member lookup" (zerop i))) | 869 | (ebrowse-show-progress "Preparing member lookup" (zerop i))) |
| 921 | (dolist (f ebrowse-member-list-accessors) | 870 | (dolist (f ebrowse-member-list-accessors) |
| 922 | (dolist (m (funcall f c)) | 871 | (dolist (m (funcall f c)) |
| 923 | (let* ((member-name (ebrowse-ms-name m)) | 872 | (push (list c f m) (gethash (ebrowse-ms-name m) members))))) |
| 924 | (value (gethash member-name members))) | ||
| 925 | (push (list c f m) value) | ||
| 926 | (puthash member-name value members))))) | ||
| 927 | (setf (ebrowse-hs-member-table ebrowse--header) members))) | 873 | (setf (ebrowse-hs-member-table ebrowse--header) members))) |
| 928 | 874 | ||
| 929 | 875 | ||
| 930 | (defun ebrowse-member-table (header) | 876 | (defun ebrowse-member-table (header) |
| 931 | "Return the member obarray. Build it if it hasn't been set up yet. | 877 | "Return the member table. Build it if it hasn't been set up yet. |
| 932 | HEADER is the tree header structure of the class tree." | 878 | HEADER is the tree header structure of the class tree." |
| 933 | (when (null (ebrowse-hs-member-table header)) | 879 | (when (null (ebrowse-hs-member-table header)) |
| 934 | (cl-loop for buffer in (ebrowse-browser-buffer-list) | 880 | (cl-loop for buffer in (ebrowse-browser-buffer-list) |
| @@ -940,19 +886,18 @@ HEADER is the tree header structure of the class tree." | |||
| 940 | 886 | ||
| 941 | 887 | ||
| 942 | 888 | ||
| 943 | ;;; Operations on TREE obarrays | 889 | ;;; Operations on TREE tables |
| 944 | 890 | ||
| 945 | (defun ebrowse-build-tree-obarray (tree) | 891 | (defun ebrowse-build-tree-table (tree) |
| 946 | "Make sure every class in TREE is represented by a unique object. | 892 | "Make sure every class in TREE is represented by a unique object. |
| 947 | Build obarray of all classes in TREE." | 893 | Build hash table of all classes in TREE." |
| 948 | (let ((classes (make-vector 127 0))) | 894 | (let ((classes (make-hash-table :test #'equal))) |
| 949 | ;; Add root classes... | 895 | ;; Add root classes... |
| 950 | (cl-loop for root in tree | 896 | (cl-loop for root in tree |
| 951 | as sym = | 897 | do (let ((name (ebrowse-qualified-class-name |
| 952 | (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) | 898 | (ebrowse-ts-class root)))) |
| 953 | classes) | 899 | (unless (gethash name classes) |
| 954 | do (unless (get sym 'ebrowse-root) | 900 | (setf (gethash name classes) root)))) |
| 955 | (setf (get sym 'ebrowse-root) root))) | ||
| 956 | ;; Process subclasses | 901 | ;; Process subclasses |
| 957 | (ebrowse-insert-supers tree classes) | 902 | (ebrowse-insert-supers tree classes) |
| 958 | classes)) | 903 | classes)) |
| @@ -962,7 +907,7 @@ Build obarray of all classes in TREE." | |||
| 962 | "Build base class lists in class tree TREE. | 907 | "Build base class lists in class tree TREE. |
| 963 | CLASSES is an obarray used to collect classes. | 908 | CLASSES is an obarray used to collect classes. |
| 964 | 909 | ||
| 965 | Helper function for `ebrowse-build-tree-obarray'. Base classes should | 910 | Helper function for `ebrowse-build-tree-table'. Base classes should |
| 966 | be ordered so that immediate base classes come first, then the base | 911 | be ordered so that immediate base classes come first, then the base |
| 967 | class of the immediate base class and so on. This means that we must | 912 | class of the immediate base class and so on. This means that we must |
| 968 | construct the base-class list top down with adding each level at the | 913 | construct the base-class list top down with adding each level at the |
| @@ -974,23 +919,21 @@ if for some reason a circle is in the inheritance graph." | |||
| 974 | as subclasses = (ebrowse-ts-subclasses class) do | 919 | as subclasses = (ebrowse-ts-subclasses class) do |
| 975 | ;; Make sure every class is represented by a unique object | 920 | ;; Make sure every class is represented by a unique object |
| 976 | (cl-loop for subclass on subclasses | 921 | (cl-loop for subclass on subclasses |
| 977 | as sym = (intern | ||
| 978 | (ebrowse-qualified-class-name | ||
| 979 | (ebrowse-ts-class (car subclass))) | ||
| 980 | classes) | ||
| 981 | do | 922 | do |
| 982 | ;; Replace the subclass tree with the one found in | 923 | (let ((name (ebrowse-qualified-class-name |
| 983 | ;; CLASSES if there is already an entry for that class | 924 | (ebrowse-ts-class (car subclass))))) |
| 984 | ;; in it. Otherwise make a new entry. | 925 | ;; Replace the subclass tree with the one found in |
| 985 | ;; | 926 | ;; CLASSES if there is already an entry for that class |
| 986 | ;; CAVEAT: If by some means (e.g., use of the | 927 | ;; in it. Otherwise make a new entry. |
| 987 | ;; preprocessor in class declarations, a name is marked | 928 | ;; |
| 988 | ;; as a subclass of itself on some path, we would end up | 929 | ;; CAVEAT: If by some means (e.g., use of the |
| 989 | ;; in an endless loop. We have to omit subclasses from | 930 | ;; preprocessor in class declarations, a name is marked |
| 990 | ;; the recursion that already have been processed. | 931 | ;; as a subclass of itself on some path, we would end up |
| 991 | (if (get sym 'ebrowse-root) | 932 | ;; in an endless loop. We have to omit subclasses from |
| 992 | (setf (car subclass) (get sym 'ebrowse-root)) | 933 | ;; the recursion that already have been processed. |
| 993 | (setf (get sym 'ebrowse-root) (car subclass)))) | 934 | (if (gethash name classes) |
| 935 | (setf (car subclass) (gethash name classes)) | ||
| 936 | (setf (gethash name classes) (car subclass))))) | ||
| 994 | ;; Process subclasses | 937 | ;; Process subclasses |
| 995 | (ebrowse-insert-supers subclasses classes))) | 938 | (ebrowse-insert-supers subclasses classes))) |
| 996 | 939 | ||
| @@ -1072,20 +1015,17 @@ Tree mode key bindings: | |||
| 1072 | (erase-buffer) | 1015 | (erase-buffer) |
| 1073 | (message nil)) | 1016 | (message nil)) |
| 1074 | 1017 | ||
| 1075 | (set (make-local-variable 'ebrowse--show-file-names-flag) nil) | 1018 | (setq-local ebrowse--show-file-names-flag nil) |
| 1076 | (set (make-local-variable 'ebrowse--tree-obarray) (make-vector 127 0)) | 1019 | (setq-local ebrowse--frozen-flag nil) |
| 1077 | (set (make-local-variable 'ebrowse--frozen-flag) nil) | ||
| 1078 | (setq mode-line-buffer-identification ident) | 1020 | (setq mode-line-buffer-identification ident) |
| 1079 | (setq buffer-read-only t) | 1021 | (setq buffer-read-only t) |
| 1080 | (add-to-invisibility-spec '(ebrowse . t)) | 1022 | (add-to-invisibility-spec '(ebrowse . t)) |
| 1081 | (set (make-local-variable 'revert-buffer-function) | 1023 | (setq-local revert-buffer-function #'ebrowse-revert-tree-buffer-from-file) |
| 1082 | #'ebrowse-revert-tree-buffer-from-file) | 1024 | (setq-local ebrowse--header header) |
| 1083 | (set (make-local-variable 'ebrowse--header) header) | 1025 | (setq-local ebrowse--tree tree) |
| 1084 | (set (make-local-variable 'ebrowse--tree) tree) | 1026 | (setq-local ebrowse--tags-file-name buffer-file-name) |
| 1085 | (set (make-local-variable 'ebrowse--tags-file-name) buffer-file-name) | 1027 | (setq-local ebrowse--tree-table (and tree (ebrowse-build-tree-table tree))) |
| 1086 | (set (make-local-variable 'ebrowse--tree-obarray) | 1028 | (setq-local ebrowse--frozen-flag nil) |
| 1087 | (and tree (ebrowse-build-tree-obarray tree))) | ||
| 1088 | (set (make-local-variable 'ebrowse--frozen-flag) nil) | ||
| 1089 | 1029 | ||
| 1090 | (add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t) | 1030 | (add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t) |
| 1091 | (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) | 1031 | (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) |
| @@ -1110,18 +1050,18 @@ Tree mode key bindings: | |||
| 1110 | (defun ebrowse-remove-class-and-kill-member-buffers (tree class) | 1050 | (defun ebrowse-remove-class-and-kill-member-buffers (tree class) |
| 1111 | "Remove from TREE class CLASS. | 1051 | "Remove from TREE class CLASS. |
| 1112 | Kill all member buffers still containing a reference to the class." | 1052 | Kill all member buffers still containing a reference to the class." |
| 1113 | (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class)) | 1053 | (setf tree (delq class tree) |
| 1114 | ebrowse--tree-obarray))) | 1054 | (gethash (ebrowse-cs-name (ebrowse-ts-class class)) |
| 1115 | (setf tree (delq class tree) | 1055 | ebrowse--tree-table) |
| 1116 | (get sym 'ebrowse-root) nil) | 1056 | nil) |
| 1117 | (dolist (root tree) | 1057 | (dolist (root tree) |
| 1118 | (setf (ebrowse-ts-subclasses root) | 1058 | (setf (ebrowse-ts-subclasses root) |
| 1119 | (delq class (ebrowse-ts-subclasses root)) | 1059 | (delq class (ebrowse-ts-subclasses root)) |
| 1120 | (ebrowse-ts-base-classes root) nil) | 1060 | (ebrowse-ts-base-classes root) nil) |
| 1121 | (ebrowse-remove-class-and-kill-member-buffers | 1061 | (ebrowse-remove-class-and-kill-member-buffers |
| 1122 | (ebrowse-ts-subclasses root) class)) | 1062 | (ebrowse-ts-subclasses root) class)) |
| 1123 | (ebrowse-kill-member-buffers-displaying class) | 1063 | (ebrowse-kill-member-buffers-displaying class) |
| 1124 | tree)) | 1064 | tree) |
| 1125 | 1065 | ||
| 1126 | 1066 | ||
| 1127 | (defun ebrowse-remove-class-at-point (forced) | 1067 | (defun ebrowse-remove-class-at-point (forced) |
| @@ -1184,7 +1124,7 @@ If given a numeric N-TIMES argument, mark that many classes." | |||
| 1184 | (defun ebrowse-mark-all-classes (prefix) | 1124 | (defun ebrowse-mark-all-classes (prefix) |
| 1185 | "Unmark, with PREFIX mark, all classes in the tree." | 1125 | "Unmark, with PREFIX mark, all classes in the tree." |
| 1186 | (interactive "P") | 1126 | (interactive "P") |
| 1187 | (ebrowse-for-all-trees (tree ebrowse--tree-obarray) | 1127 | (ebrowse-for-all-trees (tree ebrowse--tree-table) |
| 1188 | (setf (ebrowse-ts-mark tree) prefix)) | 1128 | (setf (ebrowse-ts-mark tree) prefix)) |
| 1189 | (ebrowse-redraw-marks (point-min) (point-max))) | 1129 | (ebrowse-redraw-marks (point-min) (point-max))) |
| 1190 | 1130 | ||
| @@ -1277,17 +1217,17 @@ With PREFIX, insert that many filenames." | |||
| 1277 | 1217 | ||
| 1278 | (defun ebrowse-browser-buffer-list () | 1218 | (defun ebrowse-browser-buffer-list () |
| 1279 | "Return a list of all tree or member buffers." | 1219 | "Return a list of all tree or member buffers." |
| 1280 | (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) | 1220 | (cl-delete-if-not #'ebrowse-buffer-p (buffer-list))) |
| 1281 | 1221 | ||
| 1282 | 1222 | ||
| 1283 | (defun ebrowse-member-buffer-list () | 1223 | (defun ebrowse-member-buffer-list () |
| 1284 | "Return a list of all member buffers." | 1224 | "Return a list of all member buffers." |
| 1285 | (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) | 1225 | (cl-delete-if-not #'ebrowse-member-buffer-p (buffer-list))) |
| 1286 | 1226 | ||
| 1287 | 1227 | ||
| 1288 | (defun ebrowse-tree-buffer-list () | 1228 | (defun ebrowse-tree-buffer-list () |
| 1289 | "Return a list of all tree buffers." | 1229 | "Return a list of all tree buffers." |
| 1290 | (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) | 1230 | (cl-delete-if-not #'ebrowse-tree-buffer-p (buffer-list))) |
| 1291 | 1231 | ||
| 1292 | 1232 | ||
| 1293 | (defun ebrowse-known-class-trees-buffer-list () | 1233 | (defun ebrowse-known-class-trees-buffer-list () |
| @@ -1396,7 +1336,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise." | |||
| 1396 | "): ") | 1336 | "): ") |
| 1397 | nil nil ebrowse--indentation)))) | 1337 | nil nil ebrowse--indentation)))) |
| 1398 | (when (cl-plusp width) | 1338 | (when (cl-plusp width) |
| 1399 | (set (make-local-variable 'ebrowse--indentation) width) | 1339 | (setq-local ebrowse--indentation width) |
| 1400 | (ebrowse-redraw-tree)))) | 1340 | (ebrowse-redraw-tree)))) |
| 1401 | 1341 | ||
| 1402 | 1342 | ||
| @@ -1409,7 +1349,7 @@ Read a class name from the minibuffer if CLASS is nil." | |||
| 1409 | (unless class | 1349 | (unless class |
| 1410 | (setf class | 1350 | (setf class |
| 1411 | (completing-read "Goto class: " | 1351 | (completing-read "Goto class: " |
| 1412 | (ebrowse-tree-obarray-as-alist) nil t))) | 1352 | (ebrowse-tree-table-as-alist) nil t))) |
| 1413 | (goto-char (point-min)) | 1353 | (goto-char (point-min)) |
| 1414 | (widen) | 1354 | (widen) |
| 1415 | (setq ebrowse--last-regexp (concat "\\b" class "\\b")) | 1355 | (setq ebrowse--last-regexp (concat "\\b" class "\\b")) |
| @@ -1426,37 +1366,37 @@ Read a class name from the minibuffer if CLASS is nil." | |||
| 1426 | (defun ebrowse-tree-command:show-member-variables (arg) | 1366 | (defun ebrowse-tree-command:show-member-variables (arg) |
| 1427 | "Display member variables; with prefix ARG in frozen member buffer." | 1367 | "Display member variables; with prefix ARG in frozen member buffer." |
| 1428 | (interactive "P") | 1368 | (interactive "P") |
| 1429 | (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg)) | 1369 | (ebrowse-display-member-buffer #'ebrowse-ts-member-variables arg)) |
| 1430 | 1370 | ||
| 1431 | 1371 | ||
| 1432 | (defun ebrowse-tree-command:show-member-functions (&optional arg) | 1372 | (defun ebrowse-tree-command:show-member-functions (&optional arg) |
| 1433 | "Display member functions; with prefix ARG in frozen member buffer." | 1373 | "Display member functions; with prefix ARG in frozen member buffer." |
| 1434 | (interactive "P") | 1374 | (interactive "P") |
| 1435 | (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg)) | 1375 | (ebrowse-display-member-buffer #'ebrowse-ts-member-functions arg)) |
| 1436 | 1376 | ||
| 1437 | 1377 | ||
| 1438 | (defun ebrowse-tree-command:show-static-member-variables (arg) | 1378 | (defun ebrowse-tree-command:show-static-member-variables (arg) |
| 1439 | "Display static member variables; with prefix ARG in frozen member buffer." | 1379 | "Display static member variables; with prefix ARG in frozen member buffer." |
| 1440 | (interactive "P") | 1380 | (interactive "P") |
| 1441 | (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg)) | 1381 | (ebrowse-display-member-buffer #'ebrowse-ts-static-variables arg)) |
| 1442 | 1382 | ||
| 1443 | 1383 | ||
| 1444 | (defun ebrowse-tree-command:show-static-member-functions (arg) | 1384 | (defun ebrowse-tree-command:show-static-member-functions (arg) |
| 1445 | "Display static member functions; with prefix ARG in frozen member buffer." | 1385 | "Display static member functions; with prefix ARG in frozen member buffer." |
| 1446 | (interactive "P") | 1386 | (interactive "P") |
| 1447 | (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg)) | 1387 | (ebrowse-display-member-buffer #'ebrowse-ts-static-functions arg)) |
| 1448 | 1388 | ||
| 1449 | 1389 | ||
| 1450 | (defun ebrowse-tree-command:show-friends (arg) | 1390 | (defun ebrowse-tree-command:show-friends (arg) |
| 1451 | "Display friend functions; with prefix ARG in frozen member buffer." | 1391 | "Display friend functions; with prefix ARG in frozen member buffer." |
| 1452 | (interactive "P") | 1392 | (interactive "P") |
| 1453 | (ebrowse-display-member-buffer 'ebrowse-ts-friends arg)) | 1393 | (ebrowse-display-member-buffer #'ebrowse-ts-friends arg)) |
| 1454 | 1394 | ||
| 1455 | 1395 | ||
| 1456 | (defun ebrowse-tree-command:show-types (arg) | 1396 | (defun ebrowse-tree-command:show-types (arg) |
| 1457 | "Display types defined in a class; with prefix ARG in frozen member buffer." | 1397 | "Display types defined in a class; with prefix ARG in frozen member buffer." |
| 1458 | (interactive "P") | 1398 | (interactive "P") |
| 1459 | (ebrowse-display-member-buffer 'ebrowse-ts-types arg)) | 1399 | (ebrowse-display-member-buffer #'ebrowse-ts-types arg)) |
| 1460 | 1400 | ||
| 1461 | 1401 | ||
| 1462 | 1402 | ||
| @@ -1562,12 +1502,12 @@ The new frame is deleted when you quit viewing the file in that frame." | |||
| 1562 | (had-a-buf (get-file-buffer file)) | 1502 | (had-a-buf (get-file-buffer file)) |
| 1563 | (buf-to-view (find-file-noselect file))) | 1503 | (buf-to-view (find-file-noselect file))) |
| 1564 | (switch-to-buffer-other-frame buf-to-view) | 1504 | (switch-to-buffer-other-frame buf-to-view) |
| 1565 | (set (make-local-variable 'ebrowse--frame-configuration) | 1505 | (setq-local ebrowse--frame-configuration |
| 1566 | old-frame-configuration) | 1506 | old-frame-configuration) |
| 1567 | (set (make-local-variable 'ebrowse--view-exit-action) | 1507 | (setq-local ebrowse--view-exit-action |
| 1568 | (and (not had-a-buf) | 1508 | (and (not had-a-buf) |
| 1569 | (not (buffer-modified-p buf-to-view)) | 1509 | (not (buffer-modified-p buf-to-view)) |
| 1570 | 'kill-buffer)) | 1510 | #'kill-buffer)) |
| 1571 | (view-mode-enter (cons (selected-window) (cons (selected-window) t)) | 1511 | (view-mode-enter (cons (selected-window) (cons (selected-window) t)) |
| 1572 | 'ebrowse-view-exit-fn))) | 1512 | 'ebrowse-view-exit-fn))) |
| 1573 | 1513 | ||
| @@ -1934,7 +1874,7 @@ COLLAPSE non-nil means collapse the branch." | |||
| 1934 | (when (memq 'mode-name mode-line-format) | 1874 | (when (memq 'mode-name mode-line-format) |
| 1935 | (setq mode-line-format (copy-sequence mode-line-format)) | 1875 | (setq mode-line-format (copy-sequence mode-line-format)) |
| 1936 | (setcar (memq 'mode-name mode-line-format) "Tree Buffers")) | 1876 | (setcar (memq 'mode-name mode-line-format) "Tree Buffers")) |
| 1937 | (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") | 1877 | (setq-local Helper-return-blurb "return to buffer editing") |
| 1938 | (setq truncate-lines t | 1878 | (setq truncate-lines t |
| 1939 | buffer-read-only t)) | 1879 | buffer-read-only t)) |
| 1940 | 1880 | ||
| @@ -2145,41 +2085,31 @@ See `Electric-command-loop' for a description of STATE and CONDITION." | |||
| 2145 | (define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members" | 2085 | (define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members" |
| 2146 | "Major mode for Ebrowse member buffers." | 2086 | "Major mode for Ebrowse member buffers." |
| 2147 | (mapc #'make-local-variable | 2087 | (mapc #'make-local-variable |
| 2148 | '(ebrowse--decl-column ;display column | 2088 | '(ebrowse--n-columns ;number of short columns |
| 2149 | ebrowse--n-columns ;number of short columns | ||
| 2150 | ebrowse--column-width ;width of columns above | ||
| 2151 | ebrowse--show-inherited-flag ;include inherited members? | ||
| 2152 | ebrowse--filters ;public, protected, private | ||
| 2153 | ebrowse--accessor ;vars, functions, friends | 2089 | ebrowse--accessor ;vars, functions, friends |
| 2154 | ebrowse--displayed-class ;class displayed | 2090 | ebrowse--displayed-class ;class displayed |
| 2155 | ebrowse--long-display-flag ;display with regexps? | ||
| 2156 | ebrowse--source-regexp-flag ;show source regexp? | ||
| 2157 | ebrowse--attributes-flag ;show `virtual' and `inline' | ||
| 2158 | ebrowse--member-list ;list of members displayed | 2091 | ebrowse--member-list ;list of members displayed |
| 2159 | ebrowse--tree ;the class tree | 2092 | ebrowse--tree ;the class tree |
| 2160 | ebrowse--member-mode-strings ;part of mode line | 2093 | ebrowse--member-mode-strings ;part of mode line |
| 2161 | ebrowse--tags-file-name ; | 2094 | ebrowse--tags-file-name ; |
| 2162 | ebrowse--header | 2095 | ebrowse--header |
| 2163 | ebrowse--tree-obarray | 2096 | ebrowse--tree-table |
| 2164 | ebrowse--virtual-display-flag | ||
| 2165 | ebrowse--inline-display-flag | ||
| 2166 | ebrowse--const-display-flag | ||
| 2167 | ebrowse--pure-display-flag | ||
| 2168 | ebrowse--frozen-flag)) ;buffer not automagically reused | 2097 | ebrowse--frozen-flag)) ;buffer not automagically reused |
| 2169 | (setq mode-line-buffer-identification | 2098 | (setq-local |
| 2170 | (propertized-buffer-identification "C++ Members") | 2099 | mode-line-buffer-identification |
| 2171 | buffer-read-only t | 2100 | (propertized-buffer-identification "C++ Members") |
| 2172 | ebrowse--long-display-flag nil | 2101 | buffer-read-only t |
| 2173 | ebrowse--attributes-flag t | 2102 | ebrowse--long-display-flag nil ;display with regexps? |
| 2174 | ebrowse--show-inherited-flag t | 2103 | ebrowse--attributes-flag t ;show `virtual' and `inline' |
| 2175 | ebrowse--source-regexp-flag nil | 2104 | ebrowse--show-inherited-flag t ;include inherited members? |
| 2176 | ebrowse--filters [0 1 2] | 2105 | ebrowse--source-regexp-flag nil ;show source regexp? |
| 2177 | ebrowse--decl-column ebrowse-default-declaration-column | 2106 | ebrowse--filters [0 1 2] ;public, protected, private |
| 2178 | ebrowse--column-width ebrowse-default-column-width | 2107 | ebrowse--decl-column ebrowse-default-declaration-column ;display column |
| 2179 | ebrowse--virtual-display-flag nil | 2108 | ebrowse--column-width ebrowse-default-column-width ;width of columns above |
| 2180 | ebrowse--inline-display-flag nil | 2109 | ebrowse--virtual-display-flag nil |
| 2181 | ebrowse--const-display-flag nil | 2110 | ebrowse--inline-display-flag nil |
| 2182 | ebrowse--pure-display-flag nil) | 2111 | ebrowse--const-display-flag nil |
| 2112 | ebrowse--pure-display-flag nil) | ||
| 2183 | (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))) | 2113 | (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))) |
| 2184 | 2114 | ||
| 2185 | 2115 | ||
| @@ -2257,10 +2187,10 @@ make one." | |||
| 2257 | (ebrowse-create-tree-buffer ebrowse--tree | 2187 | (ebrowse-create-tree-buffer ebrowse--tree |
| 2258 | ebrowse--tags-file-name | 2188 | ebrowse--tags-file-name |
| 2259 | ebrowse--header | 2189 | ebrowse--header |
| 2260 | ebrowse--tree-obarray | 2190 | ebrowse--tree-table |
| 2261 | 'pop)))) | 2191 | 'pop)))) |
| 2262 | (and buf | 2192 | (and buf |
| 2263 | (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf)) | 2193 | (funcall (if arg #'switch-to-buffer #'pop-to-buffer) buf)) |
| 2264 | buf)) | 2194 | buf)) |
| 2265 | 2195 | ||
| 2266 | 2196 | ||
| @@ -2276,8 +2206,9 @@ make one." | |||
| 2276 | 2206 | ||
| 2277 | (defun ebrowse-cyclic-display-next/previous-member-list (incr) | 2207 | (defun ebrowse-cyclic-display-next/previous-member-list (incr) |
| 2278 | "Switch buffer to INCR'th next/previous list of members." | 2208 | "Switch buffer to INCR'th next/previous list of members." |
| 2279 | (let ((index (ebrowse-position ebrowse--accessor | 2209 | (let ((index (seq-position ebrowse-member-list-accessors |
| 2280 | ebrowse-member-list-accessors))) | 2210 | ebrowse--accessor |
| 2211 | #'eql))) | ||
| 2281 | (setf ebrowse--accessor | 2212 | (setf ebrowse--accessor |
| 2282 | (cond ((cl-plusp incr) | 2213 | (cond ((cl-plusp incr) |
| 2283 | (or (nth (1+ index) | 2214 | (or (nth (1+ index) |
| @@ -2306,37 +2237,37 @@ make one." | |||
| 2306 | (defun ebrowse-display-function-member-list () | 2237 | (defun ebrowse-display-function-member-list () |
| 2307 | "Display the list of member functions." | 2238 | "Display the list of member functions." |
| 2308 | (interactive) | 2239 | (interactive) |
| 2309 | (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions)) | 2240 | (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-functions)) |
| 2310 | 2241 | ||
| 2311 | 2242 | ||
| 2312 | (defun ebrowse-display-variables-member-list () | 2243 | (defun ebrowse-display-variables-member-list () |
| 2313 | "Display the list of member variables." | 2244 | "Display the list of member variables." |
| 2314 | (interactive) | 2245 | (interactive) |
| 2315 | (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables)) | 2246 | (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-variables)) |
| 2316 | 2247 | ||
| 2317 | 2248 | ||
| 2318 | (defun ebrowse-display-static-variables-member-list () | 2249 | (defun ebrowse-display-static-variables-member-list () |
| 2319 | "Display the list of static member variables." | 2250 | "Display the list of static member variables." |
| 2320 | (interactive) | 2251 | (interactive) |
| 2321 | (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables)) | 2252 | (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-variables)) |
| 2322 | 2253 | ||
| 2323 | 2254 | ||
| 2324 | (defun ebrowse-display-static-functions-member-list () | 2255 | (defun ebrowse-display-static-functions-member-list () |
| 2325 | "Display the list of static member functions." | 2256 | "Display the list of static member functions." |
| 2326 | (interactive) | 2257 | (interactive) |
| 2327 | (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions)) | 2258 | (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-functions)) |
| 2328 | 2259 | ||
| 2329 | 2260 | ||
| 2330 | (defun ebrowse-display-friends-member-list () | 2261 | (defun ebrowse-display-friends-member-list () |
| 2331 | "Display the list of friends." | 2262 | "Display the list of friends." |
| 2332 | (interactive) | 2263 | (interactive) |
| 2333 | (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends)) | 2264 | (ebrowse-display-member-list-for-accessor #'ebrowse-ts-friends)) |
| 2334 | 2265 | ||
| 2335 | 2266 | ||
| 2336 | (defun ebrowse-display-types-member-list () | 2267 | (defun ebrowse-display-types-member-list () |
| 2337 | "Display the list of types." | 2268 | "Display the list of types." |
| 2338 | (interactive) | 2269 | (interactive) |
| 2339 | (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types)) | 2270 | (ebrowse-display-member-list-for-accessor #'ebrowse-ts-types)) |
| 2340 | 2271 | ||
| 2341 | 2272 | ||
| 2342 | 2273 | ||
| @@ -2565,8 +2496,8 @@ TAGS-FILE is the file name of the BROWSE file." | |||
| 2565 | "Force buffer redisplay." | 2496 | "Force buffer redisplay." |
| 2566 | (interactive) | 2497 | (interactive) |
| 2567 | (let ((display-fn (if ebrowse--long-display-flag | 2498 | (let ((display-fn (if ebrowse--long-display-flag |
| 2568 | 'ebrowse-draw-member-long-fn | 2499 | #'ebrowse-draw-member-long-fn |
| 2569 | 'ebrowse-draw-member-short-fn))) | 2500 | #'ebrowse-draw-member-short-fn))) |
| 2570 | (with-silent-modifications | 2501 | (with-silent-modifications |
| 2571 | (erase-buffer) | 2502 | (erase-buffer) |
| 2572 | ;; Show this class | 2503 | ;; Show this class |
| @@ -2610,7 +2541,7 @@ the class cursor is on." | |||
| 2610 | "Start point for member buffer creation. | 2541 | "Start point for member buffer creation. |
| 2611 | LIST is the member list to display. STAND-ALONE non-nil | 2542 | LIST is the member list to display. STAND-ALONE non-nil |
| 2612 | means the member buffer is standalone. CLASS is its class." | 2543 | means the member buffer is standalone. CLASS is its class." |
| 2613 | (let* ((classes ebrowse--tree-obarray) | 2544 | (let* ((classes ebrowse--tree-table) |
| 2614 | (tree ebrowse--tree) | 2545 | (tree ebrowse--tree) |
| 2615 | (tags-file ebrowse--tags-file-name) | 2546 | (tags-file ebrowse--tags-file-name) |
| 2616 | (header ebrowse--header) | 2547 | (header ebrowse--header) |
| @@ -2630,7 +2561,7 @@ means the member buffer is standalone. CLASS is its class." | |||
| 2630 | (setq ebrowse--member-list (funcall list class) | 2561 | (setq ebrowse--member-list (funcall list class) |
| 2631 | ebrowse--displayed-class class | 2562 | ebrowse--displayed-class class |
| 2632 | ebrowse--accessor list | 2563 | ebrowse--accessor list |
| 2633 | ebrowse--tree-obarray classes | 2564 | ebrowse--tree-table classes |
| 2634 | ebrowse--frozen-flag stand-alone | 2565 | ebrowse--frozen-flag stand-alone |
| 2635 | ebrowse--tags-file-name tags-file | 2566 | ebrowse--tags-file-name tags-file |
| 2636 | ebrowse--header header | 2567 | ebrowse--header header |
| @@ -2842,7 +2773,7 @@ REPEAT, if specified, says repeat the search REPEAT times." | |||
| 2842 | 2773 | ||
| 2843 | 2774 | ||
| 2844 | (cl-defun ebrowse-move-point-to-member (name &optional count &aux member) | 2775 | (cl-defun ebrowse-move-point-to-member (name &optional count &aux member) |
| 2845 | "Set point on member NAME in the member buffer | 2776 | "Set point on member NAME in the member buffer. |
| 2846 | COUNT, if specified, says search the COUNT'th member with the same name." | 2777 | COUNT, if specified, says search the COUNT'th member with the same name." |
| 2847 | (goto-char (point-min)) | 2778 | (goto-char (point-min)) |
| 2848 | (widen) | 2779 | (widen) |
| @@ -2867,7 +2798,8 @@ COMPL-LIST is a completion list to use." | |||
| 2867 | (class (or (ebrowse-completing-read-value title compl-list initial) | 2798 | (class (or (ebrowse-completing-read-value title compl-list initial) |
| 2868 | (error "Not found")))) | 2799 | (error "Not found")))) |
| 2869 | (setf ebrowse--displayed-class class | 2800 | (setf ebrowse--displayed-class class |
| 2870 | ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) | 2801 | ebrowse--member-list (funcall ebrowse--accessor |
| 2802 | ebrowse--displayed-class)) | ||
| 2871 | (ebrowse-redisplay-member-buffer))) | 2803 | (ebrowse-redisplay-member-buffer))) |
| 2872 | 2804 | ||
| 2873 | 2805 | ||
| @@ -2875,7 +2807,9 @@ COMPL-LIST is a completion list to use." | |||
| 2875 | "Switch member buffer to a class read from the minibuffer." | 2807 | "Switch member buffer to a class read from the minibuffer." |
| 2876 | (interactive) | 2808 | (interactive) |
| 2877 | (ebrowse-switch-member-buffer-to-other-class | 2809 | (ebrowse-switch-member-buffer-to-other-class |
| 2878 | "Goto class: " (ebrowse-tree-obarray-as-alist))) | 2810 | "Goto class: " |
| 2811 | ;; FIXME: Why not use the hash-table as-is? | ||
| 2812 | (ebrowse-tree-table-as-alist))) | ||
| 2879 | 2813 | ||
| 2880 | 2814 | ||
| 2881 | (defun ebrowse-switch-member-buffer-to-base-class (arg) | 2815 | (defun ebrowse-switch-member-buffer-to-base-class (arg) |
| @@ -2927,8 +2861,9 @@ Prefix arg INC specifies which one." | |||
| 2927 | (cl-first supers)))) | 2861 | (cl-first supers)))) |
| 2928 | (unless tree (error "Not found")) | 2862 | (unless tree (error "Not found")) |
| 2929 | (setq containing-list (ebrowse-ts-subclasses tree))))) | 2863 | (setq containing-list (ebrowse-ts-subclasses tree))))) |
| 2930 | (setq index (+ inc (ebrowse-position ebrowse--displayed-class | 2864 | (setq index (+ inc (seq-position containing-list |
| 2931 | containing-list))) | 2865 | ebrowse--displayed-class |
| 2866 | #'eql))) | ||
| 2932 | (cond ((cl-minusp index) (message "No previous class")) | 2867 | (cond ((cl-minusp index) (message "No previous class")) |
| 2933 | ((null (nth index containing-list)) (message "No next class"))) | 2868 | ((null (nth index containing-list)) (message "No next class"))) |
| 2934 | (setq index (max 0 (min index (1- (length containing-list))))) | 2869 | (setq index (max 0 (min index (1- (length containing-list))))) |
| @@ -2943,16 +2878,16 @@ Prefix arg INC specifies which one." | |||
| 2943 | Prefix arg ARG says which class should be displayed. Default is | 2878 | Prefix arg ARG says which class should be displayed. Default is |
| 2944 | the first derived class." | 2879 | the first derived class." |
| 2945 | (interactive "P") | 2880 | (interactive "P") |
| 2946 | (cl-flet ((ebrowse-tree-obarray-as-alist () | 2881 | (cl-flet ((ebrowse-tree-table-as-alist () |
| 2947 | (cl-loop for s in (ebrowse-ts-subclasses | 2882 | (cl-loop for s in (ebrowse-ts-subclasses |
| 2948 | ebrowse--displayed-class) | 2883 | ebrowse--displayed-class) |
| 2949 | collect (cons (ebrowse-cs-name | 2884 | collect (cons (ebrowse-cs-name (ebrowse-ts-class s)) |
| 2950 | (ebrowse-ts-class s)) s)))) | 2885 | s)))) |
| 2951 | (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class) | 2886 | (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class) |
| 2952 | (error "No derived classes")))) | 2887 | (error "No derived classes")))) |
| 2953 | (if (and arg (cl-second subs)) | 2888 | (if (and arg (cl-second subs)) |
| 2954 | (ebrowse-switch-member-buffer-to-other-class | 2889 | (ebrowse-switch-member-buffer-to-other-class |
| 2955 | "Goto derived class: " (ebrowse-tree-obarray-as-alist)) | 2890 | "Goto derived class: " (ebrowse-tree-table-as-alist)) |
| 2956 | (setq ebrowse--displayed-class (cl-first subs) | 2891 | (setq ebrowse--displayed-class (cl-first subs) |
| 2957 | ebrowse--member-list | 2892 | ebrowse--member-list |
| 2958 | (funcall ebrowse--accessor ebrowse--displayed-class)) | 2893 | (funcall ebrowse--accessor ebrowse--displayed-class)) |
| @@ -3403,7 +3338,8 @@ It is a list (TREE ACCESSOR MEMBER)." | |||
| 3403 | (switch-to-buffer buffer) | 3338 | (switch-to-buffer buffer) |
| 3404 | (setq ebrowse--displayed-class (cl-first info) | 3339 | (setq ebrowse--displayed-class (cl-first info) |
| 3405 | ebrowse--accessor (cl-second info) | 3340 | ebrowse--accessor (cl-second info) |
| 3406 | ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) | 3341 | ebrowse--member-list (funcall ebrowse--accessor |
| 3342 | ebrowse--displayed-class)) | ||
| 3407 | (ebrowse-redisplay-member-buffer))) | 3343 | (ebrowse-redisplay-member-buffer))) |
| 3408 | (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info))))) | 3344 | (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info))))) |
| 3409 | 3345 | ||
| @@ -3513,28 +3449,20 @@ KIND is an additional string printed in the buffer." | |||
| 3513 | (_ "unknown")) | 3449 | (_ "unknown")) |
| 3514 | "\n"))) | 3450 | "\n"))) |
| 3515 | 3451 | ||
| 3516 | (defvar ebrowse-last-completion nil | 3452 | (defvar-local ebrowse-last-completion nil |
| 3517 | "Text inserted by the last completion operation.") | 3453 | "Text inserted by the last completion operation.") |
| 3518 | 3454 | ||
| 3519 | 3455 | ||
| 3520 | (defvar ebrowse-last-completion-start nil | 3456 | (defvar-local ebrowse-last-completion-start nil |
| 3521 | "String which was the basis for the last completion operation.") | 3457 | "String which was the basis for the last completion operation.") |
| 3522 | 3458 | ||
| 3523 | 3459 | ||
| 3524 | (defvar ebrowse-last-completion-location nil | 3460 | (defvar-local ebrowse-last-completion-location nil |
| 3525 | "Buffer position at which the last completion operation was initiated.") | 3461 | "Buffer position at which the last completion operation was initiated.") |
| 3526 | 3462 | ||
| 3527 | 3463 | ||
| 3528 | (defvar ebrowse-last-completion-obarray nil | 3464 | (defvar-local ebrowse-last-completion-table nil |
| 3529 | "Member used in last completion operation.") | 3465 | "Member used in last completion operation.") |
| 3530 | |||
| 3531 | |||
| 3532 | (make-variable-buffer-local 'ebrowse-last-completion-obarray) | ||
| 3533 | (make-variable-buffer-local 'ebrowse-last-completion-location) | ||
| 3534 | (make-variable-buffer-local 'ebrowse-last-completion) | ||
| 3535 | (make-variable-buffer-local 'ebrowse-last-completion-start) | ||
| 3536 | |||
| 3537 | |||
| 3538 | 3466 | ||
| 3539 | (defun ebrowse-some-member-table () | 3467 | (defun ebrowse-some-member-table () |
| 3540 | "Return a hash table containing all members of a tree. | 3468 | "Return a hash table containing all members of a tree. |
| @@ -3552,7 +3480,7 @@ use choose a tree." | |||
| 3552 | (defun ebrowse-cyclic-successor-in-string-list (string list) | 3480 | (defun ebrowse-cyclic-successor-in-string-list (string list) |
| 3553 | "Return the item following STRING in LIST. | 3481 | "Return the item following STRING in LIST. |
| 3554 | If STRING is the last element, return the first element as successor." | 3482 | If STRING is the last element, return the first element as successor." |
| 3555 | (or (nth (1+ (ebrowse-position string list 'string=)) list) | 3483 | (or (nth (1+ (seq-position list string #'string=)) list) |
| 3556 | (cl-first list))) | 3484 | (cl-first list))) |
| 3557 | 3485 | ||
| 3558 | 3486 | ||
| @@ -3583,7 +3511,7 @@ completion." | |||
| 3583 | ;; expansion ended, insert the next expansion. | 3511 | ;; expansion ended, insert the next expansion. |
| 3584 | ((eq (point) ebrowse-last-completion-location) | 3512 | ((eq (point) ebrowse-last-completion-location) |
| 3585 | (setf list (all-completions ebrowse-last-completion-start | 3513 | (setf list (all-completions ebrowse-last-completion-start |
| 3586 | ebrowse-last-completion-obarray) | 3514 | ebrowse-last-completion-table) |
| 3587 | completion (ebrowse-cyclic-successor-in-string-list | 3515 | completion (ebrowse-cyclic-successor-in-string-list |
| 3588 | ebrowse-last-completion list)) | 3516 | ebrowse-last-completion list)) |
| 3589 | (cond ((null completion) | 3517 | (cond ((null completion) |
| @@ -3599,7 +3527,7 @@ completion." | |||
| 3599 | ;; buffer: Start new completion. | 3527 | ;; buffer: Start new completion. |
| 3600 | (t | 3528 | (t |
| 3601 | (let* ((members (ebrowse-some-member-table)) | 3529 | (let* ((members (ebrowse-some-member-table)) |
| 3602 | (completion (cl-first (all-completions pattern members nil)))) | 3530 | (completion (cl-first (all-completions pattern members)))) |
| 3603 | (cond ((eq completion t)) | 3531 | (cond ((eq completion t)) |
| 3604 | ((null completion) | 3532 | ((null completion) |
| 3605 | (error "Can't find completion for `%s'" pattern)) | 3533 | (error "Can't find completion for `%s'" pattern)) |
| @@ -3610,14 +3538,14 @@ completion." | |||
| 3610 | (setf ebrowse-last-completion-location (point) | 3538 | (setf ebrowse-last-completion-location (point) |
| 3611 | ebrowse-last-completion-start pattern | 3539 | ebrowse-last-completion-start pattern |
| 3612 | ebrowse-last-completion completion | 3540 | ebrowse-last-completion completion |
| 3613 | ebrowse-last-completion-obarray members)))))))) | 3541 | ebrowse-last-completion-table members)))))))) |
| 3614 | 3542 | ||
| 3615 | 3543 | ||
| 3616 | ;;; Tags query replace & search | 3544 | ;;; Tags query replace & search |
| 3617 | 3545 | ||
| 3618 | (defvar ebrowse-tags-loop-form () | 3546 | (defvar ebrowse-tags-loop-call '(ignore) |
| 3619 | "Form for `ebrowse-loop-continue'. | 3547 | "Function call for `ebrowse-loop-continue'. |
| 3620 | Evaluated for each file in the tree. If it returns nil, proceed | 3548 | Passed to `apply' for each file in the tree. If it returns nil, proceed |
| 3621 | with the next file.") | 3549 | with the next file.") |
| 3622 | 3550 | ||
| 3623 | (defvar ebrowse-tags-next-file-list () | 3551 | (defvar ebrowse-tags-next-file-list () |
| @@ -3684,7 +3612,7 @@ TREE-BUFFER if indirectly specifies which files to loop over." | |||
| 3684 | (when first-time | 3612 | (when first-time |
| 3685 | (ebrowse-tags-next-file first-time tree-buffer) | 3613 | (ebrowse-tags-next-file first-time tree-buffer) |
| 3686 | (goto-char (point-min))) | 3614 | (goto-char (point-min))) |
| 3687 | (while (not (eval ebrowse-tags-loop-form)) | 3615 | (while (not (apply ebrowse-tags-loop-call)) |
| 3688 | (ebrowse-tags-next-file) | 3616 | (ebrowse-tags-next-file) |
| 3689 | (message "Scanning file `%s'..." buffer-file-name) | 3617 | (message "Scanning file `%s'..." buffer-file-name) |
| 3690 | (goto-char (point-min)))) | 3618 | (goto-char (point-min)))) |
| @@ -3697,9 +3625,9 @@ If marked classes exist, process marked classes, only. | |||
| 3697 | If regular expression is nil, repeat last search." | 3625 | If regular expression is nil, repeat last search." |
| 3698 | (interactive "sTree search (regexp): ") | 3626 | (interactive "sTree search (regexp): ") |
| 3699 | (if (and (string= regexp "") | 3627 | (if (and (string= regexp "") |
| 3700 | (eq (car ebrowse-tags-loop-form) 're-search-forward)) | 3628 | (eq (car ebrowse-tags-loop-call) #'re-search-forward)) |
| 3701 | (ebrowse-tags-loop-continue) | 3629 | (ebrowse-tags-loop-continue) |
| 3702 | (setq ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) | 3630 | (setq ebrowse-tags-loop-call `(re-search-forward ,regexp nil t)) |
| 3703 | (ebrowse-tags-loop-continue 'first-time))) | 3631 | (ebrowse-tags-loop-continue 'first-time))) |
| 3704 | 3632 | ||
| 3705 | 3633 | ||
| @@ -3709,10 +3637,11 @@ If regular expression is nil, repeat last search." | |||
| 3709 | With prefix arg, process files of marked classes only." | 3637 | With prefix arg, process files of marked classes only." |
| 3710 | (interactive | 3638 | (interactive |
| 3711 | "sTree query replace (regexp): \nsTree query replace %s by: ") | 3639 | "sTree query replace (regexp): \nsTree query replace %s by: ") |
| 3712 | (setq ebrowse-tags-loop-form | 3640 | (setq ebrowse-tags-loop-call |
| 3713 | (list 'and (list 'save-excursion | 3641 | (list (lambda () |
| 3714 | (list 're-search-forward from nil t)) | 3642 | (and (save-excursion |
| 3715 | (list 'not (list 'perform-replace from to t t nil)))) | 3643 | (re-search-forward from nil t)) |
| 3644 | (not (perform-replace from to t t nil)))))) | ||
| 3716 | (ebrowse-tags-loop-continue 'first-time)) | 3645 | (ebrowse-tags-loop-continue 'first-time)) |
| 3717 | 3646 | ||
| 3718 | 3647 | ||
| @@ -3737,7 +3666,7 @@ looks like a function call to the member." | |||
| 3737 | (cl-values-list (ebrowse-tags-read-name header "Find calls of: ")))) | 3666 | (cl-values-list (ebrowse-tags-read-name header "Find calls of: ")))) |
| 3738 | ;; Set tags loop form to search for member and begin loop. | 3667 | ;; Set tags loop form to search for member and begin loop. |
| 3739 | (setq regexp (concat "\\<" name "[ \t]*(") | 3668 | (setq regexp (concat "\\<" name "[ \t]*(") |
| 3740 | ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) | 3669 | ebrowse-tags-loop-call `(re-search-forward ,regexp nil t)) |
| 3741 | (ebrowse-tags-loop-continue 'first-time tree-buffer)))) | 3670 | (ebrowse-tags-loop-continue 'first-time tree-buffer)))) |
| 3742 | 3671 | ||
| 3743 | 3672 | ||
| @@ -3746,7 +3675,7 @@ looks like a function call to the member." | |||
| 3746 | 3675 | ||
| 3747 | ;;; Structures of this kind are the elements of the position stack. | 3676 | ;;; Structures of this kind are the elements of the position stack. |
| 3748 | 3677 | ||
| 3749 | (cl-defstruct (ebrowse-position (:type vector) :named) | 3678 | (cl-defstruct (ebrowse-position) |
| 3750 | file-name ; in which file | 3679 | file-name ; in which file |
| 3751 | point ; point in file | 3680 | point ; point in file |
| 3752 | target ; t if target of a jump | 3681 | target ; t if target of a jump |
| @@ -3839,18 +3768,10 @@ Prefix arg ARG says how much." | |||
| 3839 | 3768 | ||
| 3840 | ;;; Electric position list | 3769 | ;;; Electric position list |
| 3841 | 3770 | ||
| 3842 | (defvar ebrowse-electric-position-mode-map () | 3771 | (defvar ebrowse-electric-position-mode-map |
| 3843 | "Keymap used in electric position stack window.") | ||
| 3844 | |||
| 3845 | |||
| 3846 | (defvar ebrowse-electric-position-mode-hook nil | ||
| 3847 | "If non-nil, its value is called by `ebrowse-electric-position-mode'.") | ||
| 3848 | |||
| 3849 | |||
| 3850 | (unless ebrowse-electric-position-mode-map | ||
| 3851 | (let ((map (make-keymap)) | 3772 | (let ((map (make-keymap)) |
| 3852 | (submap (make-keymap))) | 3773 | (submap (make-keymap))) |
| 3853 | (setq ebrowse-electric-position-mode-map map) | 3774 | ;; FIXME: Yuck! |
| 3854 | (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined) | 3775 | (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined) |
| 3855 | (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined) | 3776 | (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined) |
| 3856 | (define-key map "\e" submap) | 3777 | (define-key map "\e" submap) |
| @@ -3873,14 +3794,19 @@ Prefix arg ARG says how much." | |||
| 3873 | (define-key map "\e\C-v" 'scroll-other-window) | 3794 | (define-key map "\e\C-v" 'scroll-other-window) |
| 3874 | (define-key map "\e>" 'end-of-buffer) | 3795 | (define-key map "\e>" 'end-of-buffer) |
| 3875 | (define-key map "\e<" 'beginning-of-buffer) | 3796 | (define-key map "\e<" 'beginning-of-buffer) |
| 3876 | (define-key map "\e>" 'end-of-buffer))) | 3797 | (define-key map "\e>" 'end-of-buffer) |
| 3798 | map) | ||
| 3799 | "Keymap used in electric position stack window.") | ||
| 3800 | |||
| 3801 | |||
| 3802 | (defvar ebrowse-electric-position-mode-hook nil | ||
| 3803 | "If non-nil, its value is called by `ebrowse-electric-position-mode'.") | ||
| 3877 | 3804 | ||
| 3878 | (put 'ebrowse-electric-position-mode 'mode-class 'special) | ||
| 3879 | (put 'ebrowse-electric-position-undefined 'suppress-keymap t) | 3805 | (put 'ebrowse-electric-position-undefined 'suppress-keymap t) |
| 3880 | 3806 | ||
| 3881 | 3807 | ||
| 3882 | (define-derived-mode ebrowse-electric-position-mode | 3808 | (define-derived-mode ebrowse-electric-position-mode |
| 3883 | fundamental-mode "Electric Position Menu" | 3809 | special-mode "Electric Position Menu" |
| 3884 | "Mode for electric position buffers. | 3810 | "Mode for electric position buffers. |
| 3885 | Runs the hook `ebrowse-electric-position-mode-hook'." | 3811 | Runs the hook `ebrowse-electric-position-mode-hook'." |
| 3886 | (setq mode-line-buffer-identification "Electric Position Menu") | 3812 | (setq mode-line-buffer-identification "Electric Position Menu") |
| @@ -3888,7 +3814,7 @@ Runs the hook `ebrowse-electric-position-mode-hook'." | |||
| 3888 | (setq mode-line-format (copy-sequence mode-line-format)) | 3814 | (setq mode-line-format (copy-sequence mode-line-format)) |
| 3889 | ;; FIXME: Why not set `mode-name' to "Positions"? | 3815 | ;; FIXME: Why not set `mode-name' to "Positions"? |
| 3890 | (setcar (memq 'mode-name mode-line-format) "Positions")) | 3816 | (setcar (memq 'mode-name mode-line-format) "Positions")) |
| 3891 | (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") | 3817 | (setq-local Helper-return-blurb "return to buffer editing") |
| 3892 | (setq truncate-lines t | 3818 | (setq truncate-lines t |
| 3893 | buffer-read-only t)) | 3819 | buffer-read-only t)) |
| 3894 | 3820 | ||
| @@ -4101,7 +4027,7 @@ NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS | |||
| 4101 | NUMBER-OF-STATIC-VARIABLES:" | 4027 | NUMBER-OF-STATIC-VARIABLES:" |
| 4102 | (let ((classes 0) (member-functions 0) (member-variables 0) | 4028 | (let ((classes 0) (member-functions 0) (member-variables 0) |
| 4103 | (static-functions 0) (static-variables 0)) | 4029 | (static-functions 0) (static-variables 0)) |
| 4104 | (ebrowse-for-all-trees (tree ebrowse--tree-obarray) | 4030 | (ebrowse-for-all-trees (tree ebrowse--tree-table) |
| 4105 | (cl-incf classes) | 4031 | (cl-incf classes) |
| 4106 | (cl-incf member-functions (length (ebrowse-ts-member-functions tree))) | 4032 | (cl-incf member-functions (length (ebrowse-ts-member-functions tree))) |
| 4107 | (cl-incf member-variables (length (ebrowse-ts-member-variables tree))) | 4033 | (cl-incf member-variables (length (ebrowse-ts-member-variables tree))) |
| @@ -4391,10 +4317,4 @@ EVENT is the mouse event." | |||
| 4391 | 4317 | ||
| 4392 | 4318 | ||
| 4393 | (provide 'ebrowse) | 4319 | (provide 'ebrowse) |
| 4394 | |||
| 4395 | ;; Local variables: | ||
| 4396 | ;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0) | ||
| 4397 | ;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) | ||
| 4398 | ;; End: | ||
| 4399 | |||
| 4400 | ;;; ebrowse.el ends here | 4320 | ;;; ebrowse.el ends here |
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index ea3b1b816a8..7fb36873918 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el | |||
| @@ -1729,25 +1729,25 @@ this trigger is subscribed to `gdb-buf-publisher' and called with | |||
| 1729 | "Interrupt the program being debugged." | 1729 | "Interrupt the program being debugged." |
| 1730 | (interactive) | 1730 | (interactive) |
| 1731 | (interrupt-process | 1731 | (interrupt-process |
| 1732 | (get-buffer-process gud-comint-buffer) comint-ptyp)) | 1732 | (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp)) |
| 1733 | 1733 | ||
| 1734 | (defun gdb-io-quit () | 1734 | (defun gdb-io-quit () |
| 1735 | "Send quit signal to the program being debugged." | 1735 | "Send quit signal to the program being debugged." |
| 1736 | (interactive) | 1736 | (interactive) |
| 1737 | (quit-process | 1737 | (quit-process |
| 1738 | (get-buffer-process gud-comint-buffer) comint-ptyp)) | 1738 | (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp)) |
| 1739 | 1739 | ||
| 1740 | (defun gdb-io-stop () | 1740 | (defun gdb-io-stop () |
| 1741 | "Stop the program being debugged." | 1741 | "Stop the program being debugged." |
| 1742 | (interactive) | 1742 | (interactive) |
| 1743 | (stop-process | 1743 | (stop-process |
| 1744 | (get-buffer-process gud-comint-buffer) comint-ptyp)) | 1744 | (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp)) |
| 1745 | 1745 | ||
| 1746 | (defun gdb-io-eof () | 1746 | (defun gdb-io-eof () |
| 1747 | "Send end-of-file to the program being debugged." | 1747 | "Send end-of-file to the program being debugged." |
| 1748 | (interactive) | 1748 | (interactive) |
| 1749 | (process-send-eof | 1749 | (process-send-eof |
| 1750 | (get-buffer-process gud-comint-buffer))) | 1750 | (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)))) |
| 1751 | 1751 | ||
| 1752 | (defun gdb-clear-inferior-io () | 1752 | (defun gdb-clear-inferior-io () |
| 1753 | (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) | 1753 | (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) |
diff --git a/lisp/subr.el b/lisp/subr.el index 123557e736b..70f33ee5bdb 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1558,7 +1558,6 @@ be a list of the form returned by `event-start' and `event-end'." | |||
| 1558 | 1558 | ||
| 1559 | ;;;; Obsolescent names for functions. | 1559 | ;;;; Obsolescent names for functions. |
| 1560 | 1560 | ||
| 1561 | (make-obsolete 'forward-point "use (+ (point) N) instead." "23.1") | ||
| 1562 | (make-obsolete 'buffer-has-markers-at nil "24.3") | 1561 | (make-obsolete 'buffer-has-markers-at nil "24.3") |
| 1563 | 1562 | ||
| 1564 | (make-obsolete 'invocation-directory "use the variable of the same name." | 1563 | (make-obsolete 'invocation-directory "use the variable of the same name." |
| @@ -1580,6 +1579,11 @@ be a list of the form returned by `event-start' and `event-end'." | |||
| 1580 | (make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") | 1579 | (make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") |
| 1581 | (make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1") | 1580 | (make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1") |
| 1582 | 1581 | ||
| 1582 | (defun forward-point (n) | ||
| 1583 | "Return buffer position N characters after (before if N negative) point." | ||
| 1584 | (declare (obsolete "use (+ (point) N) instead." "23.1")) | ||
| 1585 | (+ (point) n)) | ||
| 1586 | |||
| 1583 | (defun log10 (x) | 1587 | (defun log10 (x) |
| 1584 | "Return (log X 10), the log base 10 of X." | 1588 | "Return (log X 10), the log base 10 of X." |
| 1585 | (declare (obsolete log "24.4")) | 1589 | (declare (obsolete log "24.4")) |
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 79312757a2d..722fc0a3137 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el | |||
| @@ -405,27 +405,31 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode', | |||
| 405 | 405 | ||
| 406 | \\{conf-mode-map}" | 406 | \\{conf-mode-map}" |
| 407 | 407 | ||
| 408 | ;; `conf-mode' plays two roles: it's the parent of several sub-modes | 408 | (setq-local font-lock-defaults '(conf-font-lock-keywords nil t nil nil)) |
| 409 | ;; but it's also the function that chooses between those submodes. | 409 | ;; Let newcomment.el decide this for itself. |
| 410 | ;; To tell the difference between those two cases where the function | 410 | ;; (setq-local comment-use-syntax t) |
| 411 | ;; might be called, we check `delay-mode-hooks'. | 411 | (setq-local parse-sexp-ignore-comments t) |
| 412 | ;; (adopted from tex-mode.el) | 412 | (setq-local outline-regexp "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)") |
| 413 | (if (not delay-mode-hooks) | 413 | (setq-local outline-heading-end-regexp "[\n}]") |
| 414 | (funcall (conf--guess-mode)) | 414 | (setq-local outline-level #'conf-outline-level) |
| 415 | 415 | (setq-local imenu-generic-expression | |
| 416 | (setq-local font-lock-defaults '(conf-font-lock-keywords nil t nil nil)) | 416 | '(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1) |
| 417 | ;; Let newcomment.el decide this for itself. | 417 | ;; [section] |
| 418 | ;; (setq-local comment-use-syntax t) | 418 | (nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1) |
| 419 | (setq-local parse-sexp-ignore-comments t) | 419 | ;; section { ... } |
| 420 | (setq-local outline-regexp "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)") | 420 | (nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1)))) |
| 421 | (setq-local outline-heading-end-regexp "[\n}]") | 421 | |
| 422 | (setq-local outline-level #'conf-outline-level) | 422 | ;; `conf-mode' plays two roles: it's the parent of several sub-modes |
| 423 | (setq-local imenu-generic-expression | 423 | ;; but it's also the function that chooses between those submodes. |
| 424 | '(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1) | 424 | ;; To tell the difference between those two cases where the function |
| 425 | ;; [section] | 425 | ;; might be called, we check `delay-mode-hooks'. |
| 426 | (nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1) | 426 | ;; (inspired from tex-mode.el) |
| 427 | ;; section { ... } | 427 | (advice-add 'conf-mode :around |
| 428 | (nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1))))) | 428 | (lambda (orig-fun) |
| 429 | "Redirect to one of the submodes when called directly." | ||
| 430 | (funcall (if delay-mode-hooks orig-fun (conf--guess-mode))))) | ||
| 431 | |||
| 432 | |||
| 429 | 433 | ||
| 430 | (defun conf-mode-initialize (comment &optional font-lock) | 434 | (defun conf-mode-initialize (comment &optional font-lock) |
| 431 | "Initializations for sub-modes of `conf-mode'. | 435 | "Initializations for sub-modes of `conf-mode'. |
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index f95979e2fcb..1b302e34a73 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el | |||
| @@ -224,7 +224,7 @@ Should show the queue(s) that \\[tex-print] puts jobs on." | |||
| 224 | :group 'tex-view) | 224 | :group 'tex-view) |
| 225 | 225 | ||
| 226 | ;;;###autoload | 226 | ;;;###autoload |
| 227 | (defcustom tex-default-mode 'latex-mode | 227 | (defcustom tex-default-mode #'latex-mode |
| 228 | "Mode to enter for a new file that might be either TeX or LaTeX. | 228 | "Mode to enter for a new file that might be either TeX or LaTeX. |
| 229 | This variable is used when it can't be determined whether the file | 229 | This variable is used when it can't be determined whether the file |
| 230 | is plain TeX or LaTeX or what because the file contains no commands. | 230 | is plain TeX or LaTeX or what because the file contains no commands. |
| @@ -668,7 +668,9 @@ An alternative value is \" . \", if you use a font with a narrow period." | |||
| 668 | "Default expressions to highlight in TeX modes.") | 668 | "Default expressions to highlight in TeX modes.") |
| 669 | 669 | ||
| 670 | (defvar tex-verbatim-environments | 670 | (defvar tex-verbatim-environments |
| 671 | '("verbatim" "verbatim*")) | 671 | '("verbatim" "verbatim*" |
| 672 | "Verbatim" ;; From "fancyvrb" | ||
| 673 | )) | ||
| 672 | (put 'tex-verbatim-environments 'safe-local-variable | 674 | (put 'tex-verbatim-environments 'safe-local-variable |
| 673 | (lambda (x) (not (memq nil (mapcar #'stringp x))))) | 675 | (lambda (x) (not (memq nil (mapcar #'stringp x))))) |
| 674 | 676 | ||
| @@ -966,7 +968,7 @@ Inherits `shell-mode-map' with a few additions.") | |||
| 966 | 968 | ||
| 967 | ;; This would be a lot simpler if we just used a regexp search, | 969 | ;; This would be a lot simpler if we just used a regexp search, |
| 968 | ;; but then it would be too slow. | 970 | ;; but then it would be too slow. |
| 969 | (defun tex-guess-mode () | 971 | (defun tex--guess-mode () |
| 970 | (let ((mode tex-default-mode) slash comment) | 972 | (let ((mode tex-default-mode) slash comment) |
| 971 | (save-excursion | 973 | (save-excursion |
| 972 | (goto-char (point-min)) | 974 | (goto-char (point-min)) |
| @@ -983,52 +985,40 @@ Inherits `shell-mode-map' with a few additions.") | |||
| 983 | (regexp-opt '("documentstyle" "documentclass" | 985 | (regexp-opt '("documentstyle" "documentclass" |
| 984 | "begin" "subsection" "section" | 986 | "begin" "subsection" "section" |
| 985 | "part" "chapter" "newcommand" | 987 | "part" "chapter" "newcommand" |
| 986 | "renewcommand" "RequirePackage") 'words) | 988 | "renewcommand" "RequirePackage") |
| 989 | 'words) | ||
| 987 | "\\|NeedsTeXFormat{LaTeX"))) | 990 | "\\|NeedsTeXFormat{LaTeX"))) |
| 988 | (if (and (looking-at | 991 | (if (and (looking-at |
| 989 | "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}") | 992 | "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}") |
| 990 | ;; SliTeX is almost never used any more nowadays. | 993 | ;; SliTeX is almost never used any more nowadays. |
| 991 | (tex-executable-exists-p slitex-run-command)) | 994 | (tex-executable-exists-p slitex-run-command)) |
| 992 | 'slitex-mode | 995 | #'slitex-mode |
| 993 | 'latex-mode) | 996 | #'latex-mode) |
| 994 | 'plain-tex-mode)))) | 997 | #'plain-tex-mode)))) |
| 995 | (funcall mode))) | 998 | mode)) |
| 996 | 999 | ||
| 997 | ;; `tex-mode' plays two roles: it's the parent of several sub-modes | 1000 | ;; `tex-mode' plays two roles: it's the parent of several sub-modes |
| 998 | ;; but it's also the function that chooses between those submodes. | 1001 | ;; but it's also the function that chooses between those submodes. |
| 999 | ;; To tell the difference between those two cases where the function | 1002 | ;; To tell the difference between those two cases where the function |
| 1000 | ;; might be called, we check `delay-mode-hooks'. | 1003 | ;; might be called, we check `delay-mode-hooks'. |
| 1001 | (define-derived-mode tex-mode text-mode "generic-TeX" | ||
| 1002 | (tex-common-initialization)) | ||
| 1003 | ;; We now move the function and define it again. This gives a warning | ||
| 1004 | ;; in the byte-compiler :-( but it's difficult to avoid because | ||
| 1005 | ;; `define-derived-mode' will necessarily define the function once | ||
| 1006 | ;; and we need to define it a second time for `autoload' to get the | ||
| 1007 | ;; proper docstring. | ||
| 1008 | (defalias 'tex-mode-internal (symbol-function 'tex-mode)) | ||
| 1009 | |||
| 1010 | ;; Suppress the byte-compiler warning about multiple definitions. | ||
| 1011 | ;; This is a) ugly, and b) cheating, but this was the last | ||
| 1012 | ;; remaining warning from byte-compiling all of Emacs... | ||
| 1013 | (eval-when-compile | ||
| 1014 | (if (boundp 'byte-compile-function-environment) | ||
| 1015 | (setq byte-compile-function-environment | ||
| 1016 | (delq (assq 'tex-mode byte-compile-function-environment) | ||
| 1017 | byte-compile-function-environment)))) | ||
| 1018 | |||
| 1019 | ;;;###autoload | 1004 | ;;;###autoload |
| 1020 | (defun tex-mode () | 1005 | (define-derived-mode tex-mode text-mode "generic-TeX" |
| 1021 | "Major mode for editing files of input for TeX, LaTeX, or SliTeX. | 1006 | "Major mode for editing files of input for TeX, LaTeX, or SliTeX. |
| 1007 | This is the shared parent mode of several submodes. | ||
| 1022 | Tries to determine (by looking at the beginning of the file) whether | 1008 | Tries to determine (by looking at the beginning of the file) whether |
| 1023 | this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode', | 1009 | this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode', |
| 1024 | `latex-mode', or `slitex-mode', respectively. If it cannot be determined, | 1010 | `latex-mode', or `slitex-mode', accordingly. If it cannot be determined, |
| 1025 | such as if there are no commands in the file, the value of `tex-default-mode' | 1011 | such as if there are no commands in the file, the value of `tex-default-mode' |
| 1026 | says which mode to use." | 1012 | says which mode to use." |
| 1027 | (interactive) | 1013 | (tex-common-initialization)) |
| 1028 | (if delay-mode-hooks | 1014 | |
| 1029 | ;; We're called from one of the children already. | 1015 | (advice-add 'tex-mode :around #'tex--redirect-to-submode) |
| 1030 | (tex-mode-internal) | 1016 | (defun tex--redirect-to-submode (orig-fun) |
| 1031 | (tex-guess-mode))) | 1017 | "Redirect to one of the submodes when called directly." |
| 1018 | (funcall (if delay-mode-hooks | ||
| 1019 | ;; We're called from one of the children already. | ||
| 1020 | orig-fun | ||
| 1021 | (tex--guess-mode)))) | ||
| 1032 | 1022 | ||
| 1033 | ;; The following three autoloaded aliases appear to conflict with | 1023 | ;; The following three autoloaded aliases appear to conflict with |
| 1034 | ;; AUCTeX. However, even though AUCTeX uses the mixed case variants | 1024 | ;; AUCTeX. However, even though AUCTeX uses the mixed case variants |
| @@ -1037,6 +1027,10 @@ says which mode to use." | |||
| 1037 | ;; AUCTeX to provide a fully functional user-level replacement. So | 1027 | ;; AUCTeX to provide a fully functional user-level replacement. So |
| 1038 | ;; these aliases should remain as they are, in particular since AUCTeX | 1028 | ;; these aliases should remain as they are, in particular since AUCTeX |
| 1039 | ;; users are likely to use them. | 1029 | ;; users are likely to use them. |
| 1030 | ;; Note from Stef: I don't understand the above explanation, the only | ||
| 1031 | ;; justification I can find to keep those confusing aliases is for those | ||
| 1032 | ;; users who may have files annotated with -*- LaTeX -*- (e.g. because they | ||
| 1033 | ;; received them from someone using AUCTeX). | ||
| 1040 | 1034 | ||
| 1041 | ;;;###autoload | 1035 | ;;;###autoload |
| 1042 | (defalias 'TeX-mode 'tex-mode) | 1036 | (defalias 'TeX-mode 'tex-mode) |
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 8171a585158..da2d5ed50e4 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el | |||
| @@ -2720,7 +2720,9 @@ hunk text is not found in the source file." | |||
| 2720 | ;; When initialization is requested, we should be in a brand new | 2720 | ;; When initialization is requested, we should be in a brand new |
| 2721 | ;; temp buffer. | 2721 | ;; temp buffer. |
| 2722 | (cl-assert (null buffer-file-name)) | 2722 | (cl-assert (null buffer-file-name)) |
| 2723 | (let ((enable-local-variables :safe) ;; to find `mode:' | 2723 | ;; Use `:safe' to find `mode:'. In case of hunk-only, use nil because |
| 2724 | ;; Local Variables list might be incomplete when context is truncated. | ||
| 2725 | (let ((enable-local-variables (unless hunk-only :safe)) | ||
| 2724 | (buffer-file-name file)) | 2726 | (buffer-file-name file)) |
| 2725 | ;; Don't run hooks that might assume buffer-file-name | 2727 | ;; Don't run hooks that might assume buffer-file-name |
| 2726 | ;; really associates buffer with a file (bug#39190). | 2728 | ;; really associates buffer with a file (bug#39190). |
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 38b4937e854..b760e170676 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el | |||
| @@ -1287,6 +1287,16 @@ state of item at point, if any." | |||
| 1287 | (list vc-dir-backend files only-files-list state model))) | 1287 | (list vc-dir-backend files only-files-list state model))) |
| 1288 | 1288 | ||
| 1289 | ;;;###autoload | 1289 | ;;;###autoload |
| 1290 | (defun vc-dir-root () | ||
| 1291 | "Run `vc-dir' in the repository root directory without prompt. | ||
| 1292 | If the default directory of the current buffer is | ||
| 1293 | not under version control, prompt for a directory." | ||
| 1294 | (interactive) | ||
| 1295 | (let ((root-dir (vc-root-dir))) | ||
| 1296 | (if root-dir (vc-dir root-dir) | ||
| 1297 | (call-interactively 'vc-dir)))) | ||
| 1298 | |||
| 1299 | ;;;###autoload | ||
| 1290 | (defun vc-dir (dir &optional backend) | 1300 | (defun vc-dir (dir &optional backend) |
| 1291 | "Show the VC status for \"interesting\" files in and below DIR. | 1301 | "Show the VC status for \"interesting\" files in and below DIR. |
| 1292 | This allows you to mark files and perform VC operations on them. | 1302 | This allows you to mark files and perform VC operations on them. |
| @@ -1309,7 +1319,7 @@ These are the commands available for use in the file status buffer: | |||
| 1309 | ;; When you hit C-x v d in a visited VC file, | 1319 | ;; When you hit C-x v d in a visited VC file, |
| 1310 | ;; the *vc-dir* buffer visits the directory under its truename; | 1320 | ;; the *vc-dir* buffer visits the directory under its truename; |
| 1311 | ;; therefore it makes sense to always do that. | 1321 | ;; therefore it makes sense to always do that. |
| 1312 | ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d | 1322 | ;; Otherwise if you do C-x v d -> C-x C-f -> C-x v d |
| 1313 | ;; you may get a new *vc-dir* buffer, different from the original | 1323 | ;; you may get a new *vc-dir* buffer, different from the original |
| 1314 | (file-truename (read-directory-name "VC status for directory: " | 1324 | (file-truename (read-directory-name "VC status for directory: " |
| 1315 | (vc-root-dir) nil t | 1325 | (vc-root-dir) nil t |
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 345a28d3f1d..2ca9d3e620c 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el | |||
| @@ -972,9 +972,9 @@ In the latter case, VC mode is deactivated for this buffer." | |||
| 972 | (bindings--define-key map [vc-ignore] | 972 | (bindings--define-key map [vc-ignore] |
| 973 | '(menu-item "Ignore File..." vc-ignore | 973 | '(menu-item "Ignore File..." vc-ignore |
| 974 | :help "Ignore a file under current version control system")) | 974 | :help "Ignore a file under current version control system")) |
| 975 | (bindings--define-key map [vc-dir] | 975 | (bindings--define-key map [vc-dir-root] |
| 976 | '(menu-item "VC Dir" vc-dir | 976 | '(menu-item "VC Dir" vc-dir-root |
| 977 | :help "Show the VC status of files in a directory")) | 977 | :help "Show the VC status of the repository")) |
| 978 | map)) | 978 | map)) |
| 979 | 979 | ||
| 980 | (defalias 'vc-menu-map vc-menu-map) | 980 | (defalias 'vc-menu-map vc-menu-map) |
| @@ -1,5 +1,5 @@ | |||
| 1 | # acl.m4 - check for access control list (ACL) primitives | 1 | # acl.m4 - check for access control list (ACL) primitives |
| 2 | # serial 23 | 2 | # serial 24 |
| 3 | 3 | ||
| 4 | # Copyright (C) 2002, 2004-2020 Free Software Foundation, Inc. | 4 | # Copyright (C) 2002, 2004-2020 Free Software Foundation, Inc. |
| 5 | # This file is free software; the Free Software Foundation | 5 | # This file is free software; the Free Software Foundation |
| @@ -139,7 +139,7 @@ int type = ACL_TYPE_EXTENDED;]])], | |||
| 139 | AC_MSG_WARN([AC_PACKAGE_NAME will be built without ACL support.]) | 139 | AC_MSG_WARN([AC_PACKAGE_NAME will be built without ACL support.]) |
| 140 | fi | 140 | fi |
| 141 | fi | 141 | fi |
| 142 | test $gl_need_lib_has_acl && LIB_HAS_ACL=$LIB_ACL | 142 | test -n "$gl_need_lib_has_acl" && LIB_HAS_ACL=$LIB_ACL |
| 143 | AC_SUBST([LIB_ACL]) | 143 | AC_SUBST([LIB_ACL]) |
| 144 | AC_DEFINE_UNQUOTED([USE_ACL], [$use_acl], | 144 | AC_DEFINE_UNQUOTED([USE_ACL], [$use_acl], |
| 145 | [Define to nonzero if you want access control list support.]) | 145 | [Define to nonzero if you want access control list support.]) |
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 3228aa42b57..d5faa9a1950 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 | |||
| @@ -69,7 +69,6 @@ AC_DEFUN([gl_EARLY], | |||
| 69 | # Code from module diffseq: | 69 | # Code from module diffseq: |
| 70 | # Code from module dirent: | 70 | # Code from module dirent: |
| 71 | # Code from module dirfd: | 71 | # Code from module dirfd: |
| 72 | # Code from module dosname: | ||
| 73 | # Code from module double-slash-root: | 72 | # Code from module double-slash-root: |
| 74 | # Code from module dtoastr: | 73 | # Code from module dtoastr: |
| 75 | # Code from module dtotimespec: | 74 | # Code from module dtotimespec: |
| @@ -87,6 +86,7 @@ AC_DEFUN([gl_EARLY], | |||
| 87 | # Code from module fcntl-h: | 86 | # Code from module fcntl-h: |
| 88 | # Code from module fdopendir: | 87 | # Code from module fdopendir: |
| 89 | # Code from module filemode: | 88 | # Code from module filemode: |
| 89 | # Code from module filename: | ||
| 90 | # Code from module filevercmp: | 90 | # Code from module filevercmp: |
| 91 | # Code from module flexmember: | 91 | # Code from module flexmember: |
| 92 | # Code from module fpending: | 92 | # Code from module fpending: |
| @@ -961,7 +961,6 @@ AC_DEFUN([gl_FILE_LIST], [ | |||
| 961 | lib/diffseq.h | 961 | lib/diffseq.h |
| 962 | lib/dirent.in.h | 962 | lib/dirent.in.h |
| 963 | lib/dirfd.c | 963 | lib/dirfd.c |
| 964 | lib/dosname.h | ||
| 965 | lib/dtoastr.c | 964 | lib/dtoastr.c |
| 966 | lib/dtotimespec.c | 965 | lib/dtotimespec.c |
| 967 | lib/dup2.c | 966 | lib/dup2.c |
| @@ -977,6 +976,7 @@ AC_DEFUN([gl_FILE_LIST], [ | |||
| 977 | lib/fdopendir.c | 976 | lib/fdopendir.c |
| 978 | lib/filemode.c | 977 | lib/filemode.c |
| 979 | lib/filemode.h | 978 | lib/filemode.h |
| 979 | lib/filename.h | ||
| 980 | lib/filevercmp.c | 980 | lib/filevercmp.c |
| 981 | lib/filevercmp.h | 981 | lib/filevercmp.h |
| 982 | lib/flexmember.h | 982 | lib/flexmember.h |
diff --git a/src/bignum.h b/src/bignum.h index 0c2541a9dc7..ad9021f15fd 100644 --- a/src/bignum.h +++ b/src/bignum.h | |||
| @@ -55,7 +55,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT) | |||
| 55 | ARG_NONNULL ((1, 2)); | 55 | ARG_NONNULL ((1, 2)); |
| 56 | extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long) | 56 | extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long) |
| 57 | ARG_NONNULL ((1, 2)); | 57 | ARG_NONNULL ((1, 2)); |
| 58 | extern double mpz_get_d_rounded (mpz_t const); | 58 | extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST; |
| 59 | 59 | ||
| 60 | INLINE_HEADER_BEGIN | 60 | INLINE_HEADER_BEGIN |
| 61 | 61 | ||
diff --git a/src/buffer.c b/src/buffer.c index cc7d4e4817c..70598a7a22a 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -131,6 +131,23 @@ CHECK_OVERLAY (Lisp_Object x) | |||
| 131 | CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); | 131 | CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); |
| 132 | } | 132 | } |
| 133 | 133 | ||
| 134 | /* Convert the position POS to an EMACS_INT that fits in a fixnum. | ||
| 135 | Yield POS's value if POS is already a fixnum, POS's marker position | ||
| 136 | if POS is a marker, and MOST_NEGATIVE_FIXNUM or | ||
| 137 | MOST_POSITIVE_FIXNUM if POS is a negative or positive bignum. | ||
| 138 | Signal an error if POS is not of the proper form. */ | ||
| 139 | |||
| 140 | EMACS_INT | ||
| 141 | fix_position (Lisp_Object pos) | ||
| 142 | { | ||
| 143 | if (FIXNUMP (pos)) | ||
| 144 | return XFIXNUM (pos); | ||
| 145 | if (MARKERP (pos)) | ||
| 146 | return marker_position (pos); | ||
| 147 | CHECK_TYPE (BIGNUMP (pos), Qinteger_or_marker_p, pos); | ||
| 148 | return !NILP (Fnatnump (pos)) ? MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM; | ||
| 149 | } | ||
| 150 | |||
| 134 | /* These setters are used only in this file, so they can be private. | 151 | /* These setters are used only in this file, so they can be private. |
| 135 | The public setters are inline functions defined in buffer.h. */ | 152 | The public setters are inline functions defined in buffer.h. */ |
| 136 | static void | 153 | static void |
| @@ -2257,19 +2274,20 @@ so the buffer is truly empty after this. */) | |||
| 2257 | } | 2274 | } |
| 2258 | 2275 | ||
| 2259 | void | 2276 | void |
| 2260 | validate_region (register Lisp_Object *b, register Lisp_Object *e) | 2277 | validate_region (Lisp_Object *b, Lisp_Object *e) |
| 2261 | { | 2278 | { |
| 2262 | CHECK_FIXNUM_COERCE_MARKER (*b); | 2279 | EMACS_INT beg = fix_position (*b), end = fix_position (*e); |
| 2263 | CHECK_FIXNUM_COERCE_MARKER (*e); | ||
| 2264 | 2280 | ||
| 2265 | if (XFIXNUM (*b) > XFIXNUM (*e)) | 2281 | if (end < beg) |
| 2266 | { | 2282 | { |
| 2267 | Lisp_Object tem; | 2283 | EMACS_INT tem = beg; beg = end; end = tem; |
| 2268 | tem = *b; *b = *e; *e = tem; | ||
| 2269 | } | 2284 | } |
| 2270 | 2285 | ||
| 2271 | if (! (BEGV <= XFIXNUM (*b) && XFIXNUM (*e) <= ZV)) | 2286 | if (! (BEGV <= beg && end <= ZV)) |
| 2272 | args_out_of_range_3 (Fcurrent_buffer (), *b, *e); | 2287 | args_out_of_range_3 (Fcurrent_buffer (), *b, *e); |
| 2288 | |||
| 2289 | *b = make_fixnum (beg); | ||
| 2290 | *e = make_fixnum (end); | ||
| 2273 | } | 2291 | } |
| 2274 | 2292 | ||
| 2275 | /* Advance BYTE_POS up to a character boundary | 2293 | /* Advance BYTE_POS up to a character boundary |
diff --git a/src/buffer.h b/src/buffer.h index fd05fdd37de..31f497ea40a 100644 --- a/src/buffer.h +++ b/src/buffer.h | |||
| @@ -1150,6 +1150,8 @@ extern Lisp_Object interval_insert_behind_hooks; | |||
| 1150 | extern Lisp_Object interval_insert_in_front_hooks; | 1150 | extern Lisp_Object interval_insert_in_front_hooks; |
| 1151 | 1151 | ||
| 1152 | 1152 | ||
| 1153 | extern EMACS_INT fix_position (Lisp_Object); | ||
| 1154 | #define CHECK_FIXNUM_COERCE_MARKER(x) ((x) = make_fixnum (fix_position (x))) | ||
| 1153 | extern void delete_all_overlays (struct buffer *); | 1155 | extern void delete_all_overlays (struct buffer *); |
| 1154 | extern void reset_buffer (struct buffer *); | 1156 | extern void reset_buffer (struct buffer *); |
| 1155 | extern void compact_buffer (struct buffer *); | 1157 | extern void compact_buffer (struct buffer *); |
diff --git a/src/character.c b/src/character.c index 5d419a2e836..d71cb3f145c 100644 --- a/src/character.c +++ b/src/character.c | |||
| @@ -931,10 +931,10 @@ character is not ASCII nor 8-bit character, an error is signaled. */) | |||
| 931 | } | 931 | } |
| 932 | else | 932 | else |
| 933 | { | 933 | { |
| 934 | CHECK_FIXNUM_COERCE_MARKER (position); | 934 | EMACS_INT fixed_pos = fix_position (position); |
| 935 | if (XFIXNUM (position) < BEGV || XFIXNUM (position) >= ZV) | 935 | if (! (BEGV <= fixed_pos && fixed_pos < ZV)) |
| 936 | args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); | 936 | args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); |
| 937 | pos = XFIXNAT (position); | 937 | pos = fixed_pos; |
| 938 | p = CHAR_POS_ADDR (pos); | 938 | p = CHAR_POS_ADDR (pos); |
| 939 | } | 939 | } |
| 940 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) | 940 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
diff --git a/src/cmds.c b/src/cmds.c index 5d7a45e65f6..c342cd88bd8 100644 --- a/src/cmds.c +++ b/src/cmds.c | |||
| @@ -31,15 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 31 | 31 | ||
| 32 | static int internal_self_insert (int, EMACS_INT); | 32 | static int internal_self_insert (int, EMACS_INT); |
| 33 | 33 | ||
| 34 | DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, | ||
| 35 | doc: /* Return buffer position N characters after (before if N negative) point. */) | ||
| 36 | (Lisp_Object n) | ||
| 37 | { | ||
| 38 | CHECK_FIXNUM (n); | ||
| 39 | |||
| 40 | return make_fixnum (PT + XFIXNUM (n)); | ||
| 41 | } | ||
| 42 | |||
| 43 | /* Add N to point; or subtract N if FORWARD is false. N defaults to 1. | 34 | /* Add N to point; or subtract N if FORWARD is false. N defaults to 1. |
| 44 | Validate the new location. Return nil. */ | 35 | Validate the new location. Return nil. */ |
| 45 | static Lisp_Object | 36 | static Lisp_Object |
| @@ -460,7 +451,10 @@ internal_self_insert (int c, EMACS_INT n) | |||
| 460 | string = concat2 (string, tem); | 451 | string = concat2 (string, tem); |
| 461 | } | 452 | } |
| 462 | 453 | ||
| 463 | replace_range (PT, PT + chars_to_delete, string, 1, 1, 1, 0); | 454 | ptrdiff_t to; |
| 455 | if (INT_ADD_WRAPV (PT, chars_to_delete, &to)) | ||
| 456 | to = PTRDIFF_MAX; | ||
| 457 | replace_range (PT, to, string, 1, 1, 1, 0); | ||
| 464 | Fforward_char (make_fixnum (n)); | 458 | Fforward_char (make_fixnum (n)); |
| 465 | } | 459 | } |
| 466 | else if (n > 1) | 460 | else if (n > 1) |
| @@ -526,7 +520,6 @@ syms_of_cmds (void) | |||
| 526 | This is run after inserting the character. */); | 520 | This is run after inserting the character. */); |
| 527 | Vpost_self_insert_hook = Qnil; | 521 | Vpost_self_insert_hook = Qnil; |
| 528 | 522 | ||
| 529 | defsubr (&Sforward_point); | ||
| 530 | defsubr (&Sforward_char); | 523 | defsubr (&Sforward_char); |
| 531 | defsubr (&Sbackward_char); | 524 | defsubr (&Sbackward_char); |
| 532 | defsubr (&Sforward_line); | 525 | defsubr (&Sforward_line); |
diff --git a/src/coding.c b/src/coding.c index 8b54281c0bf..0bea2a0c2bc 100644 --- a/src/coding.c +++ b/src/coding.c | |||
| @@ -9023,23 +9023,23 @@ DEFUN ("find-coding-systems-region-internal", | |||
| 9023 | } | 9023 | } |
| 9024 | else | 9024 | else |
| 9025 | { | 9025 | { |
| 9026 | CHECK_FIXNUM_COERCE_MARKER (start); | 9026 | EMACS_INT s = fix_position (start); |
| 9027 | CHECK_FIXNUM_COERCE_MARKER (end); | 9027 | EMACS_INT e = fix_position (end); |
| 9028 | if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) | 9028 | if (! (BEG <= s && s <= e && e <= Z)) |
| 9029 | args_out_of_range (start, end); | 9029 | args_out_of_range (start, end); |
| 9030 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) | 9030 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 9031 | return Qt; | 9031 | return Qt; |
| 9032 | start_byte = CHAR_TO_BYTE (XFIXNUM (start)); | 9032 | start_byte = CHAR_TO_BYTE (s); |
| 9033 | end_byte = CHAR_TO_BYTE (XFIXNUM (end)); | 9033 | end_byte = CHAR_TO_BYTE (e); |
| 9034 | if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) | 9034 | if (e - s == end_byte - start_byte) |
| 9035 | return Qt; | 9035 | return Qt; |
| 9036 | 9036 | ||
| 9037 | if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) | 9037 | if (s < GPT && GPT < e) |
| 9038 | { | 9038 | { |
| 9039 | if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) | 9039 | if (GPT - s < e - GPT) |
| 9040 | move_gap_both (XFIXNUM (start), start_byte); | 9040 | move_gap_both (s, start_byte); |
| 9041 | else | 9041 | else |
| 9042 | move_gap_both (XFIXNUM (end), end_byte); | 9042 | move_gap_both (e, end_byte); |
| 9043 | } | 9043 | } |
| 9044 | } | 9044 | } |
| 9045 | 9045 | ||
| @@ -9277,25 +9277,25 @@ is nil. */) | |||
| 9277 | } | 9277 | } |
| 9278 | else | 9278 | else |
| 9279 | { | 9279 | { |
| 9280 | CHECK_FIXNUM_COERCE_MARKER (start); | 9280 | EMACS_INT s = fix_position (start); |
| 9281 | CHECK_FIXNUM_COERCE_MARKER (end); | 9281 | EMACS_INT e = fix_position (end); |
| 9282 | if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) | 9282 | if (! (BEG <= s && s <= e && e <= Z)) |
| 9283 | args_out_of_range (start, end); | 9283 | args_out_of_range (start, end); |
| 9284 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) | 9284 | if (NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 9285 | return Qnil; | 9285 | return Qnil; |
| 9286 | start_byte = CHAR_TO_BYTE (XFIXNUM (start)); | 9286 | start_byte = CHAR_TO_BYTE (s); |
| 9287 | end_byte = CHAR_TO_BYTE (XFIXNUM (end)); | 9287 | end_byte = CHAR_TO_BYTE (e); |
| 9288 | if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) | 9288 | if (e - s == end_byte - start_byte) |
| 9289 | return Qnil; | 9289 | return Qnil; |
| 9290 | 9290 | ||
| 9291 | if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) | 9291 | if (s < GPT && GPT < e) |
| 9292 | { | 9292 | { |
| 9293 | if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) | 9293 | if (GPT - s < e - GPT) |
| 9294 | move_gap_both (XFIXNUM (start), start_byte); | 9294 | move_gap_both (s, start_byte); |
| 9295 | else | 9295 | else |
| 9296 | move_gap_both (XFIXNUM (end), end_byte); | 9296 | move_gap_both (e, end_byte); |
| 9297 | } | 9297 | } |
| 9298 | pos = XFIXNUM (start); | 9298 | pos = s; |
| 9299 | } | 9299 | } |
| 9300 | 9300 | ||
| 9301 | list = Qnil; | 9301 | list = Qnil; |
diff --git a/src/composite.c b/src/composite.c index 84de334ce0d..a00a4541f5e 100644 --- a/src/composite.c +++ b/src/composite.c | |||
| @@ -1839,27 +1839,24 @@ See `find-composition' for more details. */) | |||
| 1839 | ptrdiff_t start, end, from, to; | 1839 | ptrdiff_t start, end, from, to; |
| 1840 | int id; | 1840 | int id; |
| 1841 | 1841 | ||
| 1842 | CHECK_FIXNUM_COERCE_MARKER (pos); | 1842 | EMACS_INT fixed_pos = fix_position (pos); |
| 1843 | if (!NILP (limit)) | 1843 | if (!NILP (limit)) |
| 1844 | { | 1844 | to = clip_to_bounds (PTRDIFF_MIN, fix_position (limit), ZV); |
| 1845 | CHECK_FIXNUM_COERCE_MARKER (limit); | ||
| 1846 | to = min (XFIXNUM (limit), ZV); | ||
| 1847 | } | ||
| 1848 | else | 1845 | else |
| 1849 | to = -1; | 1846 | to = -1; |
| 1850 | 1847 | ||
| 1851 | if (!NILP (string)) | 1848 | if (!NILP (string)) |
| 1852 | { | 1849 | { |
| 1853 | CHECK_STRING (string); | 1850 | CHECK_STRING (string); |
| 1854 | if (XFIXNUM (pos) < 0 || XFIXNUM (pos) > SCHARS (string)) | 1851 | if (! (0 <= fixed_pos && fixed_pos <= SCHARS (string))) |
| 1855 | args_out_of_range (string, pos); | 1852 | args_out_of_range (string, pos); |
| 1856 | } | 1853 | } |
| 1857 | else | 1854 | else |
| 1858 | { | 1855 | { |
| 1859 | if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) > ZV) | 1856 | if (! (BEGV <= fixed_pos && fixed_pos <= ZV)) |
| 1860 | args_out_of_range (Fcurrent_buffer (), pos); | 1857 | args_out_of_range (Fcurrent_buffer (), pos); |
| 1861 | } | 1858 | } |
| 1862 | from = XFIXNUM (pos); | 1859 | from = fixed_pos; |
| 1863 | 1860 | ||
| 1864 | if (!find_composition (from, to, &start, &end, &prop, string)) | 1861 | if (!find_composition (from, to, &start, &end, &prop, string)) |
| 1865 | { | 1862 | { |
| @@ -1870,12 +1867,12 @@ See `find-composition' for more details. */) | |||
| 1870 | return list3 (make_fixnum (start), make_fixnum (end), gstring); | 1867 | return list3 (make_fixnum (start), make_fixnum (end), gstring); |
| 1871 | return Qnil; | 1868 | return Qnil; |
| 1872 | } | 1869 | } |
| 1873 | if ((end <= XFIXNUM (pos) || start > XFIXNUM (pos))) | 1870 | if (! (start <= fixed_pos && fixed_pos < end)) |
| 1874 | { | 1871 | { |
| 1875 | ptrdiff_t s, e; | 1872 | ptrdiff_t s, e; |
| 1876 | 1873 | ||
| 1877 | if (find_automatic_composition (from, to, &s, &e, &gstring, string) | 1874 | if (find_automatic_composition (from, to, &s, &e, &gstring, string) |
| 1878 | && (e <= XFIXNUM (pos) ? e > end : s < start)) | 1875 | && (e <= fixed_pos ? e > end : s < start)) |
| 1879 | return list3 (make_fixnum (s), make_fixnum (e), gstring); | 1876 | return list3 (make_fixnum (s), make_fixnum (e), gstring); |
| 1880 | } | 1877 | } |
| 1881 | if (!composition_valid_p (start, end, prop)) | 1878 | if (!composition_valid_p (start, end, prop)) |
diff --git a/src/data.c b/src/data.c index 2820f647981..b53b8409b59 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -2368,6 +2368,24 @@ bool-vector. IDX starts at 0. */) | |||
| 2368 | 2368 | ||
| 2369 | /* Arithmetic functions */ | 2369 | /* Arithmetic functions */ |
| 2370 | 2370 | ||
| 2371 | static Lisp_Object | ||
| 2372 | check_integer_coerce_marker (Lisp_Object x) | ||
| 2373 | { | ||
| 2374 | if (MARKERP (x)) | ||
| 2375 | return make_fixnum (marker_position (x)); | ||
| 2376 | CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); | ||
| 2377 | return x; | ||
| 2378 | } | ||
| 2379 | |||
| 2380 | static Lisp_Object | ||
| 2381 | check_number_coerce_marker (Lisp_Object x) | ||
| 2382 | { | ||
| 2383 | if (MARKERP (x)) | ||
| 2384 | return make_fixnum (marker_position (x)); | ||
| 2385 | CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); | ||
| 2386 | return x; | ||
| 2387 | } | ||
| 2388 | |||
| 2371 | Lisp_Object | 2389 | Lisp_Object |
| 2372 | arithcompare (Lisp_Object num1, Lisp_Object num2, | 2390 | arithcompare (Lisp_Object num1, Lisp_Object num2, |
| 2373 | enum Arith_Comparison comparison) | 2391 | enum Arith_Comparison comparison) |
| @@ -2376,8 +2394,8 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, | |||
| 2376 | bool lt, eq = true, gt; | 2394 | bool lt, eq = true, gt; |
| 2377 | bool test; | 2395 | bool test; |
| 2378 | 2396 | ||
| 2379 | CHECK_NUMBER_COERCE_MARKER (num1); | 2397 | num1 = check_number_coerce_marker (num1); |
| 2380 | CHECK_NUMBER_COERCE_MARKER (num2); | 2398 | num2 = check_number_coerce_marker (num2); |
| 2381 | 2399 | ||
| 2382 | /* If the comparison is mostly done by comparing two doubles, | 2400 | /* If the comparison is mostly done by comparing two doubles, |
| 2383 | set LT, EQ, and GT to the <, ==, > results of that comparison, | 2401 | set LT, EQ, and GT to the <, ==, > results of that comparison, |
| @@ -2779,9 +2797,7 @@ floatop_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, | |||
| 2779 | argnum++; | 2797 | argnum++; |
| 2780 | if (argnum == nargs) | 2798 | if (argnum == nargs) |
| 2781 | return make_float (accum); | 2799 | return make_float (accum); |
| 2782 | Lisp_Object val = args[argnum]; | 2800 | next = XFLOATINT (check_number_coerce_marker (args[argnum])); |
| 2783 | CHECK_NUMBER_COERCE_MARKER (val); | ||
| 2784 | next = XFLOATINT (val); | ||
| 2785 | } | 2801 | } |
| 2786 | } | 2802 | } |
| 2787 | 2803 | ||
| @@ -2843,8 +2859,7 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, | |||
| 2843 | argnum++; | 2859 | argnum++; |
| 2844 | if (argnum == nargs) | 2860 | if (argnum == nargs) |
| 2845 | return make_integer_mpz (); | 2861 | return make_integer_mpz (); |
| 2846 | val = args[argnum]; | 2862 | val = check_number_coerce_marker (args[argnum]); |
| 2847 | CHECK_NUMBER_COERCE_MARKER (val); | ||
| 2848 | if (FLOATP (val)) | 2863 | if (FLOATP (val)) |
| 2849 | return float_arith_driver (code, nargs, args, argnum, | 2864 | return float_arith_driver (code, nargs, args, argnum, |
| 2850 | mpz_get_d_rounded (*accum), val); | 2865 | mpz_get_d_rounded (*accum), val); |
| @@ -2873,8 +2888,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, | |||
| 2873 | argnum++; | 2888 | argnum++; |
| 2874 | if (argnum == nargs) | 2889 | if (argnum == nargs) |
| 2875 | return make_int (accum); | 2890 | return make_int (accum); |
| 2876 | val = args[argnum]; | 2891 | val = check_number_coerce_marker (args[argnum]); |
| 2877 | CHECK_NUMBER_COERCE_MARKER (val); | ||
| 2878 | 2892 | ||
| 2879 | /* Set NEXT to the next value if it fits, else exit the loop. */ | 2893 | /* Set NEXT to the next value if it fits, else exit the loop. */ |
| 2880 | intmax_t next; | 2894 | intmax_t next; |
| @@ -2921,8 +2935,7 @@ usage: (+ &rest NUMBERS-OR-MARKERS) */) | |||
| 2921 | { | 2935 | { |
| 2922 | if (nargs == 0) | 2936 | if (nargs == 0) |
| 2923 | return make_fixnum (0); | 2937 | return make_fixnum (0); |
| 2924 | Lisp_Object a = args[0]; | 2938 | Lisp_Object a = check_number_coerce_marker (args[0]); |
| 2925 | CHECK_NUMBER_COERCE_MARKER (a); | ||
| 2926 | return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a); | 2939 | return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a); |
| 2927 | } | 2940 | } |
| 2928 | 2941 | ||
| @@ -2935,8 +2948,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) | |||
| 2935 | { | 2948 | { |
| 2936 | if (nargs == 0) | 2949 | if (nargs == 0) |
| 2937 | return make_fixnum (0); | 2950 | return make_fixnum (0); |
| 2938 | Lisp_Object a = args[0]; | 2951 | Lisp_Object a = check_number_coerce_marker (args[0]); |
| 2939 | CHECK_NUMBER_COERCE_MARKER (a); | ||
| 2940 | if (nargs == 1) | 2952 | if (nargs == 1) |
| 2941 | { | 2953 | { |
| 2942 | if (FIXNUMP (a)) | 2954 | if (FIXNUMP (a)) |
| @@ -2956,8 +2968,7 @@ usage: (* &rest NUMBERS-OR-MARKERS) */) | |||
| 2956 | { | 2968 | { |
| 2957 | if (nargs == 0) | 2969 | if (nargs == 0) |
| 2958 | return make_fixnum (1); | 2970 | return make_fixnum (1); |
| 2959 | Lisp_Object a = args[0]; | 2971 | Lisp_Object a = check_number_coerce_marker (args[0]); |
| 2960 | CHECK_NUMBER_COERCE_MARKER (a); | ||
| 2961 | return nargs == 1 ? a : arith_driver (Amult, nargs, args, a); | 2972 | return nargs == 1 ? a : arith_driver (Amult, nargs, args, a); |
| 2962 | } | 2973 | } |
| 2963 | 2974 | ||
| @@ -2969,8 +2980,7 @@ The arguments must be numbers or markers. | |||
| 2969 | usage: (/ NUMBER &rest DIVISORS) */) | 2980 | usage: (/ NUMBER &rest DIVISORS) */) |
| 2970 | (ptrdiff_t nargs, Lisp_Object *args) | 2981 | (ptrdiff_t nargs, Lisp_Object *args) |
| 2971 | { | 2982 | { |
| 2972 | Lisp_Object a = args[0]; | 2983 | Lisp_Object a = check_number_coerce_marker (args[0]); |
| 2973 | CHECK_NUMBER_COERCE_MARKER (a); | ||
| 2974 | if (nargs == 1) | 2984 | if (nargs == 1) |
| 2975 | { | 2985 | { |
| 2976 | if (FIXNUMP (a)) | 2986 | if (FIXNUMP (a)) |
| @@ -3052,10 +3062,10 @@ integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo) | |||
| 3052 | DEFUN ("%", Frem, Srem, 2, 2, 0, | 3062 | DEFUN ("%", Frem, Srem, 2, 2, 0, |
| 3053 | doc: /* Return remainder of X divided by Y. | 3063 | doc: /* Return remainder of X divided by Y. |
| 3054 | Both must be integers or markers. */) | 3064 | Both must be integers or markers. */) |
| 3055 | (register Lisp_Object x, Lisp_Object y) | 3065 | (Lisp_Object x, Lisp_Object y) |
| 3056 | { | 3066 | { |
| 3057 | CHECK_INTEGER_COERCE_MARKER (x); | 3067 | x = check_integer_coerce_marker (x); |
| 3058 | CHECK_INTEGER_COERCE_MARKER (y); | 3068 | y = check_integer_coerce_marker (y); |
| 3059 | return integer_remainder (x, y, false); | 3069 | return integer_remainder (x, y, false); |
| 3060 | } | 3070 | } |
| 3061 | 3071 | ||
| @@ -3065,8 +3075,8 @@ The result falls between zero (inclusive) and Y (exclusive). | |||
| 3065 | Both X and Y must be numbers or markers. */) | 3075 | Both X and Y must be numbers or markers. */) |
| 3066 | (Lisp_Object x, Lisp_Object y) | 3076 | (Lisp_Object x, Lisp_Object y) |
| 3067 | { | 3077 | { |
| 3068 | CHECK_NUMBER_COERCE_MARKER (x); | 3078 | x = check_number_coerce_marker (x); |
| 3069 | CHECK_NUMBER_COERCE_MARKER (y); | 3079 | y = check_number_coerce_marker (y); |
| 3070 | if (FLOATP (x) || FLOATP (y)) | 3080 | if (FLOATP (x) || FLOATP (y)) |
| 3071 | return fmod_float (x, y); | 3081 | return fmod_float (x, y); |
| 3072 | return integer_remainder (x, y, true); | 3082 | return integer_remainder (x, y, true); |
| @@ -3076,12 +3086,10 @@ static Lisp_Object | |||
| 3076 | minmax_driver (ptrdiff_t nargs, Lisp_Object *args, | 3086 | minmax_driver (ptrdiff_t nargs, Lisp_Object *args, |
| 3077 | enum Arith_Comparison comparison) | 3087 | enum Arith_Comparison comparison) |
| 3078 | { | 3088 | { |
| 3079 | Lisp_Object accum = args[0]; | 3089 | Lisp_Object accum = check_number_coerce_marker (args[0]); |
| 3080 | CHECK_NUMBER_COERCE_MARKER (accum); | ||
| 3081 | for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) | 3090 | for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) |
| 3082 | { | 3091 | { |
| 3083 | Lisp_Object val = args[argnum]; | 3092 | Lisp_Object val = check_number_coerce_marker (args[argnum]); |
| 3084 | CHECK_NUMBER_COERCE_MARKER (val); | ||
| 3085 | if (!NILP (arithcompare (val, accum, comparison))) | 3093 | if (!NILP (arithcompare (val, accum, comparison))) |
| 3086 | accum = val; | 3094 | accum = val; |
| 3087 | else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) | 3095 | else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) |
| @@ -3116,8 +3124,7 @@ usage: (logand &rest INTS-OR-MARKERS) */) | |||
| 3116 | { | 3124 | { |
| 3117 | if (nargs == 0) | 3125 | if (nargs == 0) |
| 3118 | return make_fixnum (-1); | 3126 | return make_fixnum (-1); |
| 3119 | Lisp_Object a = args[0]; | 3127 | Lisp_Object a = check_integer_coerce_marker (args[0]); |
| 3120 | CHECK_INTEGER_COERCE_MARKER (a); | ||
| 3121 | return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a); | 3128 | return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a); |
| 3122 | } | 3129 | } |
| 3123 | 3130 | ||
| @@ -3129,8 +3136,7 @@ usage: (logior &rest INTS-OR-MARKERS) */) | |||
| 3129 | { | 3136 | { |
| 3130 | if (nargs == 0) | 3137 | if (nargs == 0) |
| 3131 | return make_fixnum (0); | 3138 | return make_fixnum (0); |
| 3132 | Lisp_Object a = args[0]; | 3139 | Lisp_Object a = check_integer_coerce_marker (args[0]); |
| 3133 | CHECK_INTEGER_COERCE_MARKER (a); | ||
| 3134 | return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a); | 3140 | return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a); |
| 3135 | } | 3141 | } |
| 3136 | 3142 | ||
| @@ -3142,8 +3148,7 @@ usage: (logxor &rest INTS-OR-MARKERS) */) | |||
| 3142 | { | 3148 | { |
| 3143 | if (nargs == 0) | 3149 | if (nargs == 0) |
| 3144 | return make_fixnum (0); | 3150 | return make_fixnum (0); |
| 3145 | Lisp_Object a = args[0]; | 3151 | Lisp_Object a = check_integer_coerce_marker (args[0]); |
| 3146 | CHECK_INTEGER_COERCE_MARKER (a); | ||
| 3147 | return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a); | 3152 | return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a); |
| 3148 | } | 3153 | } |
| 3149 | 3154 | ||
| @@ -3262,9 +3267,9 @@ expt_integer (Lisp_Object x, Lisp_Object y) | |||
| 3262 | DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, | 3267 | DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, |
| 3263 | doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. | 3268 | doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. |
| 3264 | Markers are converted to integers. */) | 3269 | Markers are converted to integers. */) |
| 3265 | (register Lisp_Object number) | 3270 | (Lisp_Object number) |
| 3266 | { | 3271 | { |
| 3267 | CHECK_NUMBER_COERCE_MARKER (number); | 3272 | number = check_number_coerce_marker (number); |
| 3268 | 3273 | ||
| 3269 | if (FIXNUMP (number)) | 3274 | if (FIXNUMP (number)) |
| 3270 | return make_int (XFIXNUM (number) + 1); | 3275 | return make_int (XFIXNUM (number) + 1); |
| @@ -3277,9 +3282,9 @@ Markers are converted to integers. */) | |||
| 3277 | DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, | 3282 | DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, |
| 3278 | doc: /* Return NUMBER minus one. NUMBER may be a number or a marker. | 3283 | doc: /* Return NUMBER minus one. NUMBER may be a number or a marker. |
| 3279 | Markers are converted to integers. */) | 3284 | Markers are converted to integers. */) |
| 3280 | (register Lisp_Object number) | 3285 | (Lisp_Object number) |
| 3281 | { | 3286 | { |
| 3282 | CHECK_NUMBER_COERCE_MARKER (number); | 3287 | number = check_number_coerce_marker (number); |
| 3283 | 3288 | ||
| 3284 | if (FIXNUMP (number)) | 3289 | if (FIXNUMP (number)) |
| 3285 | return make_int (XFIXNUM (number) - 1); | 3290 | return make_int (XFIXNUM (number) - 1); |
diff --git a/src/editfns.c b/src/editfns.c index eb15566fb48..90520d0dced 100644 --- a/src/editfns.c +++ b/src/editfns.c | |||
| @@ -725,18 +725,23 @@ boundaries, bind `inhibit-field-text-motion' to t. | |||
| 725 | This function does not move point. */) | 725 | This function does not move point. */) |
| 726 | (Lisp_Object n) | 726 | (Lisp_Object n) |
| 727 | { | 727 | { |
| 728 | ptrdiff_t charpos, bytepos; | 728 | ptrdiff_t charpos, bytepos, count; |
| 729 | 729 | ||
| 730 | if (NILP (n)) | 730 | if (NILP (n)) |
| 731 | XSETFASTINT (n, 1); | 731 | count = 0; |
| 732 | else if (FIXNUMP (n)) | ||
| 733 | count = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n) - 1, BUF_BYTES_MAX); | ||
| 732 | else | 734 | else |
| 733 | CHECK_FIXNUM (n); | 735 | { |
| 736 | CHECK_INTEGER (n); | ||
| 737 | count = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX; | ||
| 738 | } | ||
| 734 | 739 | ||
| 735 | scan_newline_from_point (XFIXNUM (n) - 1, &charpos, &bytepos); | 740 | scan_newline_from_point (count, &charpos, &bytepos); |
| 736 | 741 | ||
| 737 | /* Return END constrained to the current input field. */ | 742 | /* Return END constrained to the current input field. */ |
| 738 | return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT), | 743 | return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT), |
| 739 | XFIXNUM (n) != 1 ? Qt : Qnil, | 744 | count != 0 ? Qt : Qnil, |
| 740 | Qt, Qnil); | 745 | Qt, Qnil); |
| 741 | } | 746 | } |
| 742 | 747 | ||
| @@ -763,11 +768,14 @@ This function does not move point. */) | |||
| 763 | ptrdiff_t orig = PT; | 768 | ptrdiff_t orig = PT; |
| 764 | 769 | ||
| 765 | if (NILP (n)) | 770 | if (NILP (n)) |
| 766 | XSETFASTINT (n, 1); | 771 | clipped_n = 1; |
| 772 | else if (FIXNUMP (n)) | ||
| 773 | clipped_n = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n), BUF_BYTES_MAX); | ||
| 767 | else | 774 | else |
| 768 | CHECK_FIXNUM (n); | 775 | { |
| 769 | 776 | CHECK_INTEGER (n); | |
| 770 | clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XFIXNUM (n), PTRDIFF_MAX); | 777 | clipped_n = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX; |
| 778 | } | ||
| 771 | end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0), | 779 | end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0), |
| 772 | NULL); | 780 | NULL); |
| 773 | 781 | ||
| @@ -940,10 +948,10 @@ DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0, | |||
| 940 | If POSITION is out of range, the value is nil. */) | 948 | If POSITION is out of range, the value is nil. */) |
| 941 | (Lisp_Object position) | 949 | (Lisp_Object position) |
| 942 | { | 950 | { |
| 943 | CHECK_FIXNUM_COERCE_MARKER (position); | 951 | EMACS_INT pos = fix_position (position); |
| 944 | if (XFIXNUM (position) < BEG || XFIXNUM (position) > Z) | 952 | if (! (BEG <= pos && pos <= Z)) |
| 945 | return Qnil; | 953 | return Qnil; |
| 946 | return make_fixnum (CHAR_TO_BYTE (XFIXNUM (position))); | 954 | return make_fixnum (CHAR_TO_BYTE (pos)); |
| 947 | } | 955 | } |
| 948 | 956 | ||
| 949 | DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0, | 957 | DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0, |
| @@ -1060,11 +1068,11 @@ If POS is out of range, the value is nil. */) | |||
| 1060 | } | 1068 | } |
| 1061 | else | 1069 | else |
| 1062 | { | 1070 | { |
| 1063 | CHECK_FIXNUM_COERCE_MARKER (pos); | 1071 | EMACS_INT p = fix_position (pos); |
| 1064 | if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) >= ZV) | 1072 | if (! (BEGV <= p && p < ZV)) |
| 1065 | return Qnil; | 1073 | return Qnil; |
| 1066 | 1074 | ||
| 1067 | pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); | 1075 | pos_byte = CHAR_TO_BYTE (p); |
| 1068 | } | 1076 | } |
| 1069 | 1077 | ||
| 1070 | return make_fixnum (FETCH_CHAR (pos_byte)); | 1078 | return make_fixnum (FETCH_CHAR (pos_byte)); |
| @@ -1094,12 +1102,12 @@ If POS is out of range, the value is nil. */) | |||
| 1094 | } | 1102 | } |
| 1095 | else | 1103 | else |
| 1096 | { | 1104 | { |
| 1097 | CHECK_FIXNUM_COERCE_MARKER (pos); | 1105 | EMACS_INT p = fix_position (pos); |
| 1098 | 1106 | ||
| 1099 | if (XFIXNUM (pos) <= BEGV || XFIXNUM (pos) > ZV) | 1107 | if (! (BEGV < p && p <= ZV)) |
| 1100 | return Qnil; | 1108 | return Qnil; |
| 1101 | 1109 | ||
| 1102 | pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); | 1110 | pos_byte = CHAR_TO_BYTE (p); |
| 1103 | } | 1111 | } |
| 1104 | 1112 | ||
| 1105 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) | 1113 | if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| @@ -1718,21 +1726,8 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */) | |||
| 1718 | if (!BUFFER_LIVE_P (bp)) | 1726 | if (!BUFFER_LIVE_P (bp)) |
| 1719 | error ("Selecting deleted buffer"); | 1727 | error ("Selecting deleted buffer"); |
| 1720 | 1728 | ||
| 1721 | if (NILP (start)) | 1729 | b = !NILP (start) ? fix_position (start) : BUF_BEGV (bp); |
| 1722 | b = BUF_BEGV (bp); | 1730 | e = !NILP (end) ? fix_position (end) : BUF_ZV (bp); |
| 1723 | else | ||
| 1724 | { | ||
| 1725 | CHECK_FIXNUM_COERCE_MARKER (start); | ||
| 1726 | b = XFIXNUM (start); | ||
| 1727 | } | ||
| 1728 | if (NILP (end)) | ||
| 1729 | e = BUF_ZV (bp); | ||
| 1730 | else | ||
| 1731 | { | ||
| 1732 | CHECK_FIXNUM_COERCE_MARKER (end); | ||
| 1733 | e = XFIXNUM (end); | ||
| 1734 | } | ||
| 1735 | |||
| 1736 | if (b > e) | 1731 | if (b > e) |
| 1737 | temp = b, b = e, e = temp; | 1732 | temp = b, b = e, e = temp; |
| 1738 | 1733 | ||
| @@ -1786,21 +1781,8 @@ determines whether case is significant or ignored. */) | |||
| 1786 | error ("Selecting deleted buffer"); | 1781 | error ("Selecting deleted buffer"); |
| 1787 | } | 1782 | } |
| 1788 | 1783 | ||
| 1789 | if (NILP (start1)) | 1784 | begp1 = !NILP (start1) ? fix_position (start1) : BUF_BEGV (bp1); |
| 1790 | begp1 = BUF_BEGV (bp1); | 1785 | endp1 = !NILP (end1) ? fix_position (end1) : BUF_ZV (bp1); |
| 1791 | else | ||
| 1792 | { | ||
| 1793 | CHECK_FIXNUM_COERCE_MARKER (start1); | ||
| 1794 | begp1 = XFIXNUM (start1); | ||
| 1795 | } | ||
| 1796 | if (NILP (end1)) | ||
| 1797 | endp1 = BUF_ZV (bp1); | ||
| 1798 | else | ||
| 1799 | { | ||
| 1800 | CHECK_FIXNUM_COERCE_MARKER (end1); | ||
| 1801 | endp1 = XFIXNUM (end1); | ||
| 1802 | } | ||
| 1803 | |||
| 1804 | if (begp1 > endp1) | 1786 | if (begp1 > endp1) |
| 1805 | temp = begp1, begp1 = endp1, endp1 = temp; | 1787 | temp = begp1, begp1 = endp1, endp1 = temp; |
| 1806 | 1788 | ||
| @@ -1824,21 +1806,8 @@ determines whether case is significant or ignored. */) | |||
| 1824 | error ("Selecting deleted buffer"); | 1806 | error ("Selecting deleted buffer"); |
| 1825 | } | 1807 | } |
| 1826 | 1808 | ||
| 1827 | if (NILP (start2)) | 1809 | begp2 = !NILP (start2) ? fix_position (start2) : BUF_BEGV (bp2); |
| 1828 | begp2 = BUF_BEGV (bp2); | 1810 | endp2 = !NILP (end2) ? fix_position (end2) : BUF_ZV (bp2); |
| 1829 | else | ||
| 1830 | { | ||
| 1831 | CHECK_FIXNUM_COERCE_MARKER (start2); | ||
| 1832 | begp2 = XFIXNUM (start2); | ||
| 1833 | } | ||
| 1834 | if (NILP (end2)) | ||
| 1835 | endp2 = BUF_ZV (bp2); | ||
| 1836 | else | ||
| 1837 | { | ||
| 1838 | CHECK_FIXNUM_COERCE_MARKER (end2); | ||
| 1839 | endp2 = XFIXNUM (end2); | ||
| 1840 | } | ||
| 1841 | |||
| 1842 | if (begp2 > endp2) | 1811 | if (begp2 > endp2) |
| 1843 | temp = begp2, begp2 = endp2, endp2 = temp; | 1812 | temp = begp2, begp2 = endp2, endp2 = temp; |
| 1844 | 1813 | ||
| @@ -2692,29 +2661,27 @@ See also `save-restriction'. | |||
| 2692 | When calling from Lisp, pass two arguments START and END: | 2661 | When calling from Lisp, pass two arguments START and END: |
| 2693 | positions (integers or markers) bounding the text that should | 2662 | positions (integers or markers) bounding the text that should |
| 2694 | remain visible. */) | 2663 | remain visible. */) |
| 2695 | (register Lisp_Object start, Lisp_Object end) | 2664 | (Lisp_Object start, Lisp_Object end) |
| 2696 | { | 2665 | { |
| 2697 | CHECK_FIXNUM_COERCE_MARKER (start); | 2666 | EMACS_INT s = fix_position (start), e = fix_position (end); |
| 2698 | CHECK_FIXNUM_COERCE_MARKER (end); | ||
| 2699 | 2667 | ||
| 2700 | if (XFIXNUM (start) > XFIXNUM (end)) | 2668 | if (e < s) |
| 2701 | { | 2669 | { |
| 2702 | Lisp_Object tem; | 2670 | EMACS_INT tem = s; s = e; e = tem; |
| 2703 | tem = start; start = end; end = tem; | ||
| 2704 | } | 2671 | } |
| 2705 | 2672 | ||
| 2706 | if (!(BEG <= XFIXNUM (start) && XFIXNUM (start) <= XFIXNUM (end) && XFIXNUM (end) <= Z)) | 2673 | if (!(BEG <= s && s <= e && e <= Z)) |
| 2707 | args_out_of_range (start, end); | 2674 | args_out_of_range (start, end); |
| 2708 | 2675 | ||
| 2709 | if (BEGV != XFIXNAT (start) || ZV != XFIXNAT (end)) | 2676 | if (BEGV != s || ZV != e) |
| 2710 | current_buffer->clip_changed = 1; | 2677 | current_buffer->clip_changed = 1; |
| 2711 | 2678 | ||
| 2712 | SET_BUF_BEGV (current_buffer, XFIXNAT (start)); | 2679 | SET_BUF_BEGV (current_buffer, s); |
| 2713 | SET_BUF_ZV (current_buffer, XFIXNAT (end)); | 2680 | SET_BUF_ZV (current_buffer, e); |
| 2714 | if (PT < XFIXNAT (start)) | 2681 | if (PT < s) |
| 2715 | SET_PT (XFIXNAT (start)); | 2682 | SET_PT (s); |
| 2716 | if (PT > XFIXNAT (end)) | 2683 | if (e < PT) |
| 2717 | SET_PT (XFIXNAT (end)); | 2684 | SET_PT (e); |
| 2718 | /* Changing the buffer bounds invalidates any recorded current column. */ | 2685 | /* Changing the buffer bounds invalidates any recorded current column. */ |
| 2719 | invalidate_current_column (); | 2686 | invalidate_current_column (); |
| 2720 | return Qnil; | 2687 | return Qnil; |
diff --git a/src/emacs-module.c b/src/emacs-module.c index 60f16418efa..cdcbe061b53 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c | |||
| @@ -88,6 +88,7 @@ To add a new module function, proceed as follows: | |||
| 88 | #include "dynlib.h" | 88 | #include "dynlib.h" |
| 89 | #include "coding.h" | 89 | #include "coding.h" |
| 90 | #include "keyboard.h" | 90 | #include "keyboard.h" |
| 91 | #include "process.h" | ||
| 91 | #include "syssignal.h" | 92 | #include "syssignal.h" |
| 92 | #include "sysstdio.h" | 93 | #include "sysstdio.h" |
| 93 | #include "thread.h" | 94 | #include "thread.h" |
| @@ -977,6 +978,13 @@ module_make_big_integer (emacs_env *env, int sign, | |||
| 977 | return lisp_to_value (env, make_integer_mpz ()); | 978 | return lisp_to_value (env, make_integer_mpz ()); |
| 978 | } | 979 | } |
| 979 | 980 | ||
| 981 | static int | ||
| 982 | module_open_channel (emacs_env *env, emacs_value pipe_process) | ||
| 983 | { | ||
| 984 | MODULE_FUNCTION_BEGIN (-1); | ||
| 985 | return open_channel_for_module (value_to_lisp (pipe_process)); | ||
| 986 | } | ||
| 987 | |||
| 980 | 988 | ||
| 981 | /* Subroutines. */ | 989 | /* Subroutines. */ |
| 982 | 990 | ||
| @@ -1391,6 +1399,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) | |||
| 1391 | env->make_big_integer = module_make_big_integer; | 1399 | env->make_big_integer = module_make_big_integer; |
| 1392 | env->get_function_finalizer = module_get_function_finalizer; | 1400 | env->get_function_finalizer = module_get_function_finalizer; |
| 1393 | env->set_function_finalizer = module_set_function_finalizer; | 1401 | env->set_function_finalizer = module_set_function_finalizer; |
| 1402 | env->open_channel = module_open_channel; | ||
| 1394 | Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); | 1403 | Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); |
| 1395 | return env; | 1404 | return env; |
| 1396 | } | 1405 | } |
diff --git a/src/fileio.c b/src/fileio.c index ffe79559a3f..978a373d39b 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -96,7 +96,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 96 | #include <acl.h> | 96 | #include <acl.h> |
| 97 | #include <allocator.h> | 97 | #include <allocator.h> |
| 98 | #include <careadlinkat.h> | 98 | #include <careadlinkat.h> |
| 99 | #include <dosname.h> | 99 | #include <filename.h> |
| 100 | #include <fsusage.h> | 100 | #include <fsusage.h> |
| 101 | #include <stat-time.h> | 101 | #include <stat-time.h> |
| 102 | #include <tempname.h> | 102 | #include <tempname.h> |
diff --git a/src/filelock.c b/src/filelock.c index 2b734ee00d5..ee46e0e3e00 100644 --- a/src/filelock.c +++ b/src/filelock.c | |||
| @@ -661,7 +661,7 @@ void | |||
| 661 | lock_file (Lisp_Object fn) | 661 | lock_file (Lisp_Object fn) |
| 662 | { | 662 | { |
| 663 | Lisp_Object orig_fn, encoded_fn; | 663 | Lisp_Object orig_fn, encoded_fn; |
| 664 | char *lfname; | 664 | char *lfname = NULL; |
| 665 | lock_info_type lock_info; | 665 | lock_info_type lock_info; |
| 666 | USE_SAFE_ALLOCA; | 666 | USE_SAFE_ALLOCA; |
| 667 | 667 | ||
| @@ -686,21 +686,15 @@ lock_file (Lisp_Object fn) | |||
| 686 | 686 | ||
| 687 | /* See if this file is visited and has changed on disk since it was | 687 | /* See if this file is visited and has changed on disk since it was |
| 688 | visited. */ | 688 | visited. */ |
| 689 | { | 689 | Lisp_Object subject_buf = get_truename_buffer (orig_fn); |
| 690 | register Lisp_Object subject_buf; | 690 | if (!NILP (subject_buf) |
| 691 | 691 | && NILP (Fverify_visited_file_modtime (subject_buf)) | |
| 692 | subject_buf = get_truename_buffer (orig_fn); | 692 | && !NILP (Ffile_exists_p (fn)) |
| 693 | 693 | && !(lfname && current_lock_owner (NULL, lfname) == -2)) | |
| 694 | if (!NILP (subject_buf) | 694 | call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); |
| 695 | && NILP (Fverify_visited_file_modtime (subject_buf)) | ||
| 696 | && !NILP (Ffile_exists_p (fn)) | ||
| 697 | && (!create_lockfiles || current_lock_owner (NULL, lfname) != -2)) | ||
| 698 | call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); | ||
| 699 | |||
| 700 | } | ||
| 701 | 695 | ||
| 702 | /* Don't do locking if the user has opted out. */ | 696 | /* Don't do locking if the user has opted out. */ |
| 703 | if (create_lockfiles) | 697 | if (lfname) |
| 704 | { | 698 | { |
| 705 | /* Try to lock the lock. FIXME: This ignores errors when | 699 | /* Try to lock the lock. FIXME: This ignores errors when |
| 706 | lock_if_free returns a positive errno value. */ | 700 | lock_if_free returns a positive errno value. */ |
| @@ -860,7 +854,7 @@ syms_of_filelock (void) | |||
| 860 | The name of the (per-buffer) lockfile is constructed by prepending a | 854 | The name of the (per-buffer) lockfile is constructed by prepending a |
| 861 | '.#' to the name of the file being locked. See also `lock-buffer' and | 855 | '.#' to the name of the file being locked. See also `lock-buffer' and |
| 862 | Info node `(emacs)Interlocking'. */); | 856 | Info node `(emacs)Interlocking'. */); |
| 863 | create_lockfiles = 1; | 857 | create_lockfiles = true; |
| 864 | 858 | ||
| 865 | defsubr (&Sunlock_buffer); | 859 | defsubr (&Sunlock_buffer); |
| 866 | defsubr (&Slock_buffer); | 860 | defsubr (&Slock_buffer); |
| @@ -5187,22 +5187,8 @@ extract_data_from_object (Lisp_Object spec, | |||
| 5187 | struct buffer *bp = XBUFFER (object); | 5187 | struct buffer *bp = XBUFFER (object); |
| 5188 | set_buffer_internal (bp); | 5188 | set_buffer_internal (bp); |
| 5189 | 5189 | ||
| 5190 | if (NILP (start)) | 5190 | b = !NILP (start) ? fix_position (start) : BEGV; |
| 5191 | b = BEGV; | 5191 | e = !NILP (end) ? fix_position (end) : ZV; |
| 5192 | else | ||
| 5193 | { | ||
| 5194 | CHECK_FIXNUM_COERCE_MARKER (start); | ||
| 5195 | b = XFIXNUM (start); | ||
| 5196 | } | ||
| 5197 | |||
| 5198 | if (NILP (end)) | ||
| 5199 | e = ZV; | ||
| 5200 | else | ||
| 5201 | { | ||
| 5202 | CHECK_FIXNUM_COERCE_MARKER (end); | ||
| 5203 | e = XFIXNUM (end); | ||
| 5204 | } | ||
| 5205 | |||
| 5206 | if (b > e) | 5192 | if (b > e) |
| 5207 | { | 5193 | { |
| 5208 | EMACS_INT temp = b; | 5194 | EMACS_INT temp = b; |
diff --git a/src/font.c b/src/font.c index 2a456300619..0c9e752e089 100644 --- a/src/font.c +++ b/src/font.c | |||
| @@ -4606,10 +4606,10 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, | |||
| 4606 | Lisp_Object window; | 4606 | Lisp_Object window; |
| 4607 | struct window *w; | 4607 | struct window *w; |
| 4608 | 4608 | ||
| 4609 | CHECK_FIXNUM_COERCE_MARKER (position); | 4609 | EMACS_INT fixed_pos = fix_position (position); |
| 4610 | if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) | 4610 | if (! (BEGV <= fixed_pos && fixed_pos < ZV)) |
| 4611 | args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); | 4611 | args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); |
| 4612 | pos = XFIXNUM (position); | 4612 | pos = fixed_pos; |
| 4613 | pos_byte = CHAR_TO_BYTE (pos); | 4613 | pos_byte = CHAR_TO_BYTE (pos); |
| 4614 | if (NILP (ch)) | 4614 | if (NILP (ch)) |
| 4615 | c = FETCH_CHAR (pos_byte); | 4615 | c = FETCH_CHAR (pos_byte); |
| @@ -5013,24 +5013,26 @@ character at index specified by POSITION. */) | |||
| 5013 | (Lisp_Object position, Lisp_Object window, Lisp_Object string) | 5013 | (Lisp_Object position, Lisp_Object window, Lisp_Object string) |
| 5014 | { | 5014 | { |
| 5015 | struct window *w = decode_live_window (window); | 5015 | struct window *w = decode_live_window (window); |
| 5016 | EMACS_INT pos; | ||
| 5016 | 5017 | ||
| 5017 | if (NILP (string)) | 5018 | if (NILP (string)) |
| 5018 | { | 5019 | { |
| 5019 | if (XBUFFER (w->contents) != current_buffer) | 5020 | if (XBUFFER (w->contents) != current_buffer) |
| 5020 | error ("Specified window is not displaying the current buffer"); | 5021 | error ("Specified window is not displaying the current buffer"); |
| 5021 | CHECK_FIXNUM_COERCE_MARKER (position); | 5022 | pos = fix_position (position); |
| 5022 | if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) | 5023 | if (! (BEGV <= pos && pos < ZV)) |
| 5023 | args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); | 5024 | args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); |
| 5024 | } | 5025 | } |
| 5025 | else | 5026 | else |
| 5026 | { | 5027 | { |
| 5027 | CHECK_FIXNUM (position); | 5028 | CHECK_FIXNUM (position); |
| 5028 | CHECK_STRING (string); | 5029 | CHECK_STRING (string); |
| 5029 | if (! (0 <= XFIXNUM (position) && XFIXNUM (position) < SCHARS (string))) | 5030 | pos = XFIXNUM (position); |
| 5031 | if (! (0 <= pos && pos < SCHARS (string))) | ||
| 5030 | args_out_of_range (string, position); | 5032 | args_out_of_range (string, position); |
| 5031 | } | 5033 | } |
| 5032 | 5034 | ||
| 5033 | return font_at (-1, XFIXNUM (position), NULL, w, string); | 5035 | return font_at (-1, pos, NULL, w, string); |
| 5034 | } | 5036 | } |
| 5035 | 5037 | ||
| 5036 | #if 0 | 5038 | #if 0 |
diff --git a/src/fringe.c b/src/fringe.c index 2a46e3c34f2..d8d80bb3fe9 100644 --- a/src/fringe.c +++ b/src/fringe.c | |||
| @@ -1675,10 +1675,10 @@ Return nil if POS is not visible in WINDOW. */) | |||
| 1675 | 1675 | ||
| 1676 | if (!NILP (pos)) | 1676 | if (!NILP (pos)) |
| 1677 | { | 1677 | { |
| 1678 | CHECK_FIXNUM_COERCE_MARKER (pos); | 1678 | EMACS_INT p = fix_position (pos); |
| 1679 | if (! (BEGV <= XFIXNUM (pos) && XFIXNUM (pos) <= ZV)) | 1679 | if (! (BEGV <= p && p <= ZV)) |
| 1680 | args_out_of_range (window, pos); | 1680 | args_out_of_range (window, pos); |
| 1681 | textpos = XFIXNUM (pos); | 1681 | textpos = p; |
| 1682 | } | 1682 | } |
| 1683 | else if (w == XWINDOW (selected_window)) | 1683 | else if (w == XWINDOW (selected_window)) |
| 1684 | textpos = PT; | 1684 | textpos = PT; |
diff --git a/src/lisp.h b/src/lisp.h index f86b4880f35..2f719b1f03e 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -585,7 +585,7 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, | |||
| 585 | Lisp_Object); | 585 | Lisp_Object); |
| 586 | 586 | ||
| 587 | /* Defined in bignum.c. */ | 587 | /* Defined in bignum.c. */ |
| 588 | extern double bignum_to_double (Lisp_Object); | 588 | extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST; |
| 589 | extern Lisp_Object make_bigint (intmax_t); | 589 | extern Lisp_Object make_bigint (intmax_t); |
| 590 | extern Lisp_Object make_biguint (uintmax_t); | 590 | extern Lisp_Object make_biguint (uintmax_t); |
| 591 | 591 | ||
| @@ -3023,14 +3023,6 @@ CHECK_FIXNAT (Lisp_Object x) | |||
| 3023 | CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ | 3023 | CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ |
| 3024 | } while (false) | 3024 | } while (false) |
| 3025 | 3025 | ||
| 3026 | #define CHECK_FIXNUM_COERCE_MARKER(x) \ | ||
| 3027 | do { \ | ||
| 3028 | if (MARKERP ((x))) \ | ||
| 3029 | XSETFASTINT (x, marker_position (x)); \ | ||
| 3030 | else \ | ||
| 3031 | CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x); \ | ||
| 3032 | } while (false) | ||
| 3033 | |||
| 3034 | INLINE double | 3026 | INLINE double |
| 3035 | XFLOATINT (Lisp_Object n) | 3027 | XFLOATINT (Lisp_Object n) |
| 3036 | { | 3028 | { |
| @@ -3050,22 +3042,6 @@ CHECK_INTEGER (Lisp_Object x) | |||
| 3050 | { | 3042 | { |
| 3051 | CHECK_TYPE (INTEGERP (x), Qnumberp, x); | 3043 | CHECK_TYPE (INTEGERP (x), Qnumberp, x); |
| 3052 | } | 3044 | } |
| 3053 | |||
| 3054 | #define CHECK_NUMBER_COERCE_MARKER(x) \ | ||
| 3055 | do { \ | ||
| 3056 | if (MARKERP (x)) \ | ||
| 3057 | XSETFASTINT (x, marker_position (x)); \ | ||
| 3058 | else \ | ||
| 3059 | CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \ | ||
| 3060 | } while (false) | ||
| 3061 | |||
| 3062 | #define CHECK_INTEGER_COERCE_MARKER(x) \ | ||
| 3063 | do { \ | ||
| 3064 | if (MARKERP (x)) \ | ||
| 3065 | XSETFASTINT (x, marker_position (x)); \ | ||
| 3066 | else \ | ||
| 3067 | CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x); \ | ||
| 3068 | } while (false) | ||
| 3069 | 3045 | ||
| 3070 | 3046 | ||
| 3071 | /* If we're not dumping using the legacy dumper and we might be using | 3047 | /* If we're not dumping using the legacy dumper and we might be using |
| @@ -3519,9 +3495,9 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) | |||
| 3519 | 3495 | ||
| 3520 | /* Defined in bignum.c. This part of bignum.c's API does not require | 3496 | /* Defined in bignum.c. This part of bignum.c's API does not require |
| 3521 | the caller to access bignum internals; see bignum.h for that. */ | 3497 | the caller to access bignum internals; see bignum.h for that. */ |
| 3522 | extern intmax_t bignum_to_intmax (Lisp_Object); | 3498 | extern intmax_t bignum_to_intmax (Lisp_Object) ATTRIBUTE_CONST; |
| 3523 | extern uintmax_t bignum_to_uintmax (Lisp_Object); | 3499 | extern uintmax_t bignum_to_uintmax (Lisp_Object) ATTRIBUTE_CONST; |
| 3524 | extern ptrdiff_t bignum_bufsize (Lisp_Object, int); | 3500 | extern ptrdiff_t bignum_bufsize (Lisp_Object, int) ATTRIBUTE_CONST; |
| 3525 | extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); | 3501 | extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); |
| 3526 | extern Lisp_Object bignum_to_string (Lisp_Object, int); | 3502 | extern Lisp_Object bignum_to_string (Lisp_Object, int); |
| 3527 | extern Lisp_Object make_bignum_str (char const *, int); | 3503 | extern Lisp_Object make_bignum_str (char const *, int); |
diff --git a/src/module-env-28.h b/src/module-env-28.h index a2479a8f744..5d884c148c4 100644 --- a/src/module-env-28.h +++ b/src/module-env-28.h | |||
| @@ -9,3 +9,6 @@ | |||
| 9 | void (*set_function_finalizer) (emacs_env *env, emacs_value arg, | 9 | void (*set_function_finalizer) (emacs_env *env, emacs_value arg, |
| 10 | void (*fin) (void *) EMACS_NOEXCEPT) | 10 | void (*fin) (void *) EMACS_NOEXCEPT) |
| 11 | EMACS_ATTRIBUTE_NONNULL (1); | 11 | EMACS_ATTRIBUTE_NONNULL (1); |
| 12 | |||
| 13 | int (*open_channel) (emacs_env *env, emacs_value pipe_process) | ||
| 14 | EMACS_ATTRIBUTE_NONNULL (1); | ||
diff --git a/src/process.c b/src/process.c index e4e5e57aeee..07881d6c5d3 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -8200,6 +8200,17 @@ restore_nofile_limit (void) | |||
| 8200 | #endif | 8200 | #endif |
| 8201 | } | 8201 | } |
| 8202 | 8202 | ||
| 8203 | int | ||
| 8204 | open_channel_for_module (Lisp_Object process) | ||
| 8205 | { | ||
| 8206 | CHECK_PROCESS (process); | ||
| 8207 | CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process); | ||
| 8208 | int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]); | ||
| 8209 | if (fd == -1) | ||
| 8210 | report_file_error ("Cannot duplicate file descriptor", Qnil); | ||
| 8211 | return fd; | ||
| 8212 | } | ||
| 8213 | |||
| 8203 | 8214 | ||
| 8204 | /* This is not called "init_process" because that is the name of a | 8215 | /* This is not called "init_process" because that is the name of a |
| 8205 | Mach system call, so it would cause problems on Darwin systems. */ | 8216 | Mach system call, so it would cause problems on Darwin systems. */ |
| @@ -8446,6 +8457,7 @@ amounts of data in one go. */); | |||
| 8446 | DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions"); | 8457 | DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions"); |
| 8447 | 8458 | ||
| 8448 | DEFSYM (Qnull, "null"); | 8459 | DEFSYM (Qnull, "null"); |
| 8460 | DEFSYM (Qpipe_process_p, "pipe-process-p"); | ||
| 8449 | 8461 | ||
| 8450 | defsubr (&Sprocessp); | 8462 | defsubr (&Sprocessp); |
| 8451 | defsubr (&Sget_process); | 8463 | defsubr (&Sget_process); |
diff --git a/src/process.h b/src/process.h index 7884efc5494..a783a31cb86 100644 --- a/src/process.h +++ b/src/process.h | |||
| @@ -300,6 +300,8 @@ extern Lisp_Object remove_slash_colon (Lisp_Object); | |||
| 300 | extern void update_processes_for_thread_death (Lisp_Object); | 300 | extern void update_processes_for_thread_death (Lisp_Object); |
| 301 | extern void dissociate_controlling_tty (void); | 301 | extern void dissociate_controlling_tty (void); |
| 302 | 302 | ||
| 303 | extern int open_channel_for_module (Lisp_Object); | ||
| 304 | |||
| 303 | INLINE_HEADER_END | 305 | INLINE_HEADER_END |
| 304 | 306 | ||
| 305 | #endif /* EMACS_PROCESS_H */ | 307 | #endif /* EMACS_PROCESS_H */ |
diff --git a/src/search.c b/src/search.c index 818bb4af246..7389fbef0ee 100644 --- a/src/search.c +++ b/src/search.c | |||
| @@ -1028,8 +1028,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, | |||
| 1028 | } | 1028 | } |
| 1029 | else | 1029 | else |
| 1030 | { | 1030 | { |
| 1031 | CHECK_FIXNUM_COERCE_MARKER (bound); | 1031 | lim = fix_position (bound); |
| 1032 | lim = XFIXNUM (bound); | ||
| 1033 | if (n > 0 ? lim < PT : lim > PT) | 1032 | if (n > 0 ? lim < PT : lim > PT) |
| 1034 | error ("Invalid search bound (wrong side of point)"); | 1033 | error ("Invalid search bound (wrong side of point)"); |
| 1035 | if (lim > ZV) | 1034 | if (lim > ZV) |
diff --git a/src/textprop.c b/src/textprop.c index ee048336ac0..960dba3f8dc 100644 --- a/src/textprop.c +++ b/src/textprop.c | |||
| @@ -131,6 +131,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, | |||
| 131 | { | 131 | { |
| 132 | INTERVAL i; | 132 | INTERVAL i; |
| 133 | ptrdiff_t searchpos; | 133 | ptrdiff_t searchpos; |
| 134 | Lisp_Object begin0 = *begin, end0 = *end; | ||
| 134 | 135 | ||
| 135 | CHECK_STRING_OR_BUFFER (object); | 136 | CHECK_STRING_OR_BUFFER (object); |
| 136 | CHECK_FIXNUM_COERCE_MARKER (*begin); | 137 | CHECK_FIXNUM_COERCE_MARKER (*begin); |
| @@ -155,7 +156,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, | |||
| 155 | 156 | ||
| 156 | if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) | 157 | if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) |
| 157 | && XFIXNUM (*end) <= BUF_ZV (b))) | 158 | && XFIXNUM (*end) <= BUF_ZV (b))) |
| 158 | args_out_of_range (*begin, *end); | 159 | args_out_of_range (begin0, end0); |
| 159 | i = buffer_intervals (b); | 160 | i = buffer_intervals (b); |
| 160 | 161 | ||
| 161 | /* If there's no text, there are no properties. */ | 162 | /* If there's no text, there are no properties. */ |
| @@ -170,7 +171,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, | |||
| 170 | 171 | ||
| 171 | if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) | 172 | if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) |
| 172 | && XFIXNUM (*end) <= len)) | 173 | && XFIXNUM (*end) <= len)) |
| 173 | args_out_of_range (*begin, *end); | 174 | args_out_of_range (begin0, end0); |
| 174 | i = string_intervals (object); | 175 | i = string_intervals (object); |
| 175 | 176 | ||
| 176 | if (len == 0) | 177 | if (len == 0) |
| @@ -611,7 +612,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, | |||
| 611 | { | 612 | { |
| 612 | struct window *w = 0; | 613 | struct window *w = 0; |
| 613 | 614 | ||
| 614 | CHECK_FIXNUM_COERCE_MARKER (position); | 615 | EMACS_INT pos = fix_position (position); |
| 615 | 616 | ||
| 616 | if (NILP (object)) | 617 | if (NILP (object)) |
| 617 | XSETBUFFER (object, current_buffer); | 618 | XSETBUFFER (object, current_buffer); |
| @@ -628,14 +629,14 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, | |||
| 628 | Lisp_Object *overlay_vec; | 629 | Lisp_Object *overlay_vec; |
| 629 | struct buffer *obuf = current_buffer; | 630 | struct buffer *obuf = current_buffer; |
| 630 | 631 | ||
| 631 | if (XFIXNUM (position) < BUF_BEGV (XBUFFER (object)) | 632 | if (! (BUF_BEGV (XBUFFER (object)) <= pos |
| 632 | || XFIXNUM (position) > BUF_ZV (XBUFFER (object))) | 633 | && pos <= BUF_ZV (XBUFFER (object)))) |
| 633 | xsignal1 (Qargs_out_of_range, position); | 634 | xsignal1 (Qargs_out_of_range, position); |
| 634 | 635 | ||
| 635 | set_buffer_temp (XBUFFER (object)); | 636 | set_buffer_temp (XBUFFER (object)); |
| 636 | 637 | ||
| 637 | USE_SAFE_ALLOCA; | 638 | USE_SAFE_ALLOCA; |
| 638 | GET_OVERLAYS_AT (XFIXNUM (position), overlay_vec, noverlays, NULL, false); | 639 | GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false); |
| 639 | noverlays = sort_overlays (overlay_vec, noverlays, w); | 640 | noverlays = sort_overlays (overlay_vec, noverlays, w); |
| 640 | 641 | ||
| 641 | set_buffer_temp (obuf); | 642 | set_buffer_temp (obuf); |
| @@ -662,7 +663,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, | |||
| 662 | 663 | ||
| 663 | /* Not a buffer, or no appropriate overlay, so fall through to the | 664 | /* Not a buffer, or no appropriate overlay, so fall through to the |
| 664 | simpler case. */ | 665 | simpler case. */ |
| 665 | return Fget_text_property (position, prop, object); | 666 | return Fget_text_property (make_fixnum (pos), prop, object); |
| 666 | } | 667 | } |
| 667 | 668 | ||
| 668 | DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0, | 669 | DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0, |
diff --git a/src/window.c b/src/window.c index 8cdad27b664..075fd4e550c 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -1895,10 +1895,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number | |||
| 1895 | if (EQ (pos, Qt)) | 1895 | if (EQ (pos, Qt)) |
| 1896 | posint = -1; | 1896 | posint = -1; |
| 1897 | else if (!NILP (pos)) | 1897 | else if (!NILP (pos)) |
| 1898 | { | 1898 | posint = fix_position (pos); |
| 1899 | CHECK_FIXNUM_COERCE_MARKER (pos); | ||
| 1900 | posint = XFIXNUM (pos); | ||
| 1901 | } | ||
| 1902 | else if (w == XWINDOW (selected_window)) | 1899 | else if (w == XWINDOW (selected_window)) |
| 1903 | posint = PT; | 1900 | posint = PT; |
| 1904 | else | 1901 | else |
diff --git a/src/xdisp.c b/src/xdisp.c index 04fc8aa3c45..61c798c59e8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -815,11 +815,6 @@ static struct props it_props[] = | |||
| 815 | {0, 0, NULL} | 815 | {0, 0, NULL} |
| 816 | }; | 816 | }; |
| 817 | 817 | ||
| 818 | /* Value is the position described by X. If X is a marker, value is | ||
| 819 | the marker_position of X. Otherwise, value is X. */ | ||
| 820 | |||
| 821 | #define COERCE_MARKER(X) (MARKERP ((X)) ? Fmarker_position (X) : (X)) | ||
| 822 | |||
| 823 | /* Enumeration returned by some move_it_.* functions internally. */ | 818 | /* Enumeration returned by some move_it_.* functions internally. */ |
| 824 | 819 | ||
| 825 | enum move_it_result | 820 | enum move_it_result |
| @@ -10418,10 +10413,7 @@ include the height of both, if present, in the return value. */) | |||
| 10418 | start = pos; | 10413 | start = pos; |
| 10419 | } | 10414 | } |
| 10420 | else | 10415 | else |
| 10421 | { | 10416 | start = clip_to_bounds (BEGV, fix_position (from), ZV); |
| 10422 | CHECK_FIXNUM_COERCE_MARKER (from); | ||
| 10423 | start = min (max (XFIXNUM (from), BEGV), ZV); | ||
| 10424 | } | ||
| 10425 | 10417 | ||
| 10426 | if (NILP (to)) | 10418 | if (NILP (to)) |
| 10427 | end = ZV; | 10419 | end = ZV; |
| @@ -10435,10 +10427,7 @@ include the height of both, if present, in the return value. */) | |||
| 10435 | end = pos; | 10427 | end = pos; |
| 10436 | } | 10428 | } |
| 10437 | else | 10429 | else |
| 10438 | { | 10430 | end = clip_to_bounds (start, fix_position (to), ZV); |
| 10439 | CHECK_FIXNUM_COERCE_MARKER (to); | ||
| 10440 | end = max (start, min (XFIXNUM (to), ZV)); | ||
| 10441 | } | ||
| 10442 | 10431 | ||
| 10443 | if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX)) | 10432 | if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX)) |
| 10444 | max_x = XFIXNUM (x_limit); | 10433 | max_x = XFIXNUM (x_limit); |
| @@ -14944,7 +14933,7 @@ overlay_arrows_changed_p (bool set_redisplay) | |||
| 14944 | val = find_symbol_value (var); | 14933 | val = find_symbol_value (var); |
| 14945 | if (!MARKERP (val)) | 14934 | if (!MARKERP (val)) |
| 14946 | continue; | 14935 | continue; |
| 14947 | if (! EQ (COERCE_MARKER (val), | 14936 | if (! EQ (Fmarker_position (val), |
| 14948 | /* FIXME: Don't we have a problem, using such a global | 14937 | /* FIXME: Don't we have a problem, using such a global |
| 14949 | * "last-position" if the variable is buffer-local? */ | 14938 | * "last-position" if the variable is buffer-local? */ |
| 14950 | Fget (var, Qlast_arrow_position)) | 14939 | Fget (var, Qlast_arrow_position)) |
| @@ -14987,8 +14976,7 @@ update_overlay_arrows (int up_to_date) | |||
| 14987 | Lisp_Object val = find_symbol_value (var); | 14976 | Lisp_Object val = find_symbol_value (var); |
| 14988 | if (!MARKERP (val)) | 14977 | if (!MARKERP (val)) |
| 14989 | continue; | 14978 | continue; |
| 14990 | Fput (var, Qlast_arrow_position, | 14979 | Fput (var, Qlast_arrow_position, Fmarker_position (val)); |
| 14991 | COERCE_MARKER (val)); | ||
| 14992 | Fput (var, Qlast_arrow_string, | 14980 | Fput (var, Qlast_arrow_string, |
| 14993 | overlay_arrow_string_or_property (var)); | 14981 | overlay_arrow_string_or_property (var)); |
| 14994 | } | 14982 | } |
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index ec6948921f2..5e3112f4471 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c | |||
| @@ -30,6 +30,19 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 30 | #include <string.h> | 30 | #include <string.h> |
| 31 | #include <time.h> | 31 | #include <time.h> |
| 32 | 32 | ||
| 33 | #ifdef WINDOWSNT | ||
| 34 | /* Cannot include <process.h> because of the local header by the same | ||
| 35 | name, sigh. */ | ||
| 36 | uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *); | ||
| 37 | # if !defined __x86_64__ | ||
| 38 | # define ALIGN_STACK __attribute__((force_align_arg_pointer)) | ||
| 39 | # endif | ||
| 40 | # include <windows.h> /* for Sleep */ | ||
| 41 | #else /* !WINDOWSNT */ | ||
| 42 | # include <pthread.h> | ||
| 43 | # include <unistd.h> | ||
| 44 | #endif | ||
| 45 | |||
| 33 | #ifdef HAVE_GMP | 46 | #ifdef HAVE_GMP |
| 34 | #include <gmp.h> | 47 | #include <gmp.h> |
| 35 | #else | 48 | #else |
| @@ -299,7 +312,7 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args, | |||
| 299 | } | 312 | } |
| 300 | 313 | ||
| 301 | /* An invalid finalizer: Finalizers are run during garbage collection, | 314 | /* An invalid finalizer: Finalizers are run during garbage collection, |
| 302 | where Lisp code can’t be executed. -module-assertions tests for | 315 | where Lisp code can't be executed. -module-assertions tests for |
| 303 | this case. */ | 316 | this case. */ |
| 304 | 317 | ||
| 305 | static emacs_env *current_env; | 318 | static emacs_env *current_env; |
| @@ -320,9 +333,9 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, | |||
| 320 | } | 333 | } |
| 321 | 334 | ||
| 322 | static void | 335 | static void |
| 323 | signal_errno (emacs_env *env, const char *function) | 336 | signal_system_error (emacs_env *env, int error, const char *function) |
| 324 | { | 337 | { |
| 325 | const char *message = strerror (errno); | 338 | const char *message = strerror (error); |
| 326 | emacs_value message_value = env->make_string (env, message, strlen (message)); | 339 | emacs_value message_value = env->make_string (env, message, strlen (message)); |
| 327 | emacs_value symbol = env->intern (env, "file-error"); | 340 | emacs_value symbol = env->intern (env, "file-error"); |
| 328 | emacs_value elements[2] | 341 | emacs_value elements[2] |
| @@ -331,6 +344,12 @@ signal_errno (emacs_env *env, const char *function) | |||
| 331 | env->non_local_exit_signal (env, symbol, data); | 344 | env->non_local_exit_signal (env, symbol, data); |
| 332 | } | 345 | } |
| 333 | 346 | ||
| 347 | static void | ||
| 348 | signal_errno (emacs_env *env, const char *function) | ||
| 349 | { | ||
| 350 | signal_system_error (env, errno, function); | ||
| 351 | } | ||
| 352 | |||
| 334 | /* A long-running operation that occasionally calls `should_quit' or | 353 | /* A long-running operation that occasionally calls `should_quit' or |
| 335 | `process_input'. */ | 354 | `process_input'. */ |
| 336 | 355 | ||
| @@ -533,6 +552,73 @@ Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs, | |||
| 533 | return env->funcall (env, Flist, 2, list_args); | 552 | return env->funcall (env, Flist, 2, list_args); |
| 534 | } | 553 | } |
| 535 | 554 | ||
| 555 | static void | ||
| 556 | sleep_for_half_second (void) | ||
| 557 | { | ||
| 558 | /* mingw.org's MinGW has nanosleep, but MinGW64 doesn't. */ | ||
| 559 | #ifdef WINDOWSNT | ||
| 560 | Sleep (500); | ||
| 561 | #else | ||
| 562 | const struct timespec sleep = {0, 500000000}; | ||
| 563 | if (nanosleep (&sleep, NULL) != 0) | ||
| 564 | perror ("nanosleep"); | ||
| 565 | #endif | ||
| 566 | } | ||
| 567 | |||
| 568 | #ifdef WINDOWSNT | ||
| 569 | static void ALIGN_STACK | ||
| 570 | #else | ||
| 571 | static void * | ||
| 572 | #endif | ||
| 573 | write_to_pipe (void *arg) | ||
| 574 | { | ||
| 575 | /* We sleep a bit to test that writing to a pipe is indeed possible | ||
| 576 | if no environment is active. */ | ||
| 577 | sleep_for_half_second (); | ||
| 578 | FILE *stream = arg; | ||
| 579 | /* The string below should be identical to the one we compare with | ||
| 580 | in emacs-module-tests.el:module/async-pipe. */ | ||
| 581 | if (fputs ("data from thread", stream) < 0) | ||
| 582 | perror ("fputs"); | ||
| 583 | if (fclose (stream) != 0) | ||
| 584 | perror ("close"); | ||
| 585 | #ifndef WINDOWSNT | ||
| 586 | return NULL; | ||
| 587 | #endif | ||
| 588 | } | ||
| 589 | |||
| 590 | static emacs_value | ||
| 591 | Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args, | ||
| 592 | void *data) | ||
| 593 | { | ||
| 594 | assert (nargs == 1); | ||
| 595 | int fd = env->open_channel (env, args[0]); | ||
| 596 | if (env->non_local_exit_check (env) != emacs_funcall_exit_return) | ||
| 597 | return NULL; | ||
| 598 | FILE *stream = fdopen (fd, "w"); | ||
| 599 | if (stream == NULL) | ||
| 600 | { | ||
| 601 | signal_errno (env, "fdopen"); | ||
| 602 | return NULL; | ||
| 603 | } | ||
| 604 | #ifdef WINDOWSNT | ||
| 605 | uintptr_t thd = _beginthread (write_to_pipe, 0, stream); | ||
| 606 | int error = (thd == (uintptr_t)-1L) ? errno : 0; | ||
| 607 | #else /* !WINDOWSNT */ | ||
| 608 | pthread_t thread; | ||
| 609 | int error | ||
| 610 | = pthread_create (&thread, NULL, write_to_pipe, stream); | ||
| 611 | #endif | ||
| 612 | if (error != 0) | ||
| 613 | { | ||
| 614 | signal_system_error (env, error, "thread create"); | ||
| 615 | if (fclose (stream) != 0) | ||
| 616 | perror ("fclose"); | ||
| 617 | return NULL; | ||
| 618 | } | ||
| 619 | return env->intern (env, "nil"); | ||
| 620 | } | ||
| 621 | |||
| 536 | /* Lisp utilities for easier readability (simple wrappers). */ | 622 | /* Lisp utilities for easier readability (simple wrappers). */ |
| 537 | 623 | ||
| 538 | /* Provide FEATURE to Emacs. */ | 624 | /* Provide FEATURE to Emacs. */ |
| @@ -614,6 +700,7 @@ emacs_module_init (struct emacs_runtime *ert) | |||
| 614 | Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL); | 700 | Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL); |
| 615 | DEFUN ("mod-test-function-finalizer-calls", | 701 | DEFUN ("mod-test-function-finalizer-calls", |
| 616 | Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL); | 702 | Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL); |
| 703 | DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL); | ||
| 617 | 704 | ||
| 618 | #undef DEFUN | 705 | #undef DEFUN |
| 619 | 706 | ||
diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el index e66b5c6803d..66098fa0116 100644 --- a/test/lisp/image/gravatar-tests.el +++ b/test/lisp/image/gravatar-tests.el | |||
| @@ -67,6 +67,6 @@ | |||
| 67 | (gravatar-force-default nil) | 67 | (gravatar-force-default nil) |
| 68 | (gravatar-size nil)) | 68 | (gravatar-size nil)) |
| 69 | (should (equal (gravatar-build-url "foo") "\ | 69 | (should (equal (gravatar-build-url "foo") "\ |
| 70 | https://www.gravatar.com/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g")))) | 70 | https://seccdn.libravatar.org/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g")))) |
| 71 | 71 | ||
| 72 | ;;; gravatar-tests.el ends here | 72 | ;;; gravatar-tests.el ends here |
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 48d2e86a605..6851b890451 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el | |||
| @@ -424,4 +424,21 @@ See Bug#36226." | |||
| 424 | ;; but at least one. | 424 | ;; but at least one. |
| 425 | (should (> valid-after valid-before))))) | 425 | (should (> valid-after valid-before))))) |
| 426 | 426 | ||
| 427 | (ert-deftest module/async-pipe () | ||
| 428 | "Check that writing data from another thread works." | ||
| 429 | (skip-unless (not (eq system-type 'windows-nt))) ; FIXME! | ||
| 430 | (with-temp-buffer | ||
| 431 | (let ((process (make-pipe-process :name "module/async-pipe" | ||
| 432 | :buffer (current-buffer) | ||
| 433 | :coding 'utf-8-unix | ||
| 434 | :noquery t))) | ||
| 435 | (unwind-protect | ||
| 436 | (progn | ||
| 437 | (mod-test-async-pipe process) | ||
| 438 | (should (accept-process-output process 1)) | ||
| 439 | ;; The string below must be identical to what | ||
| 440 | ;; mod-test.c:write_to_pipe produces. | ||
| 441 | (should (equal (buffer-string) "data from thread"))) | ||
| 442 | (delete-process process))))) | ||
| 443 | |||
| 427 | ;;; emacs-module-tests.el ends here | 444 | ;;; emacs-module-tests.el ends here |