diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2022-08-29 14:33:31 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2022-08-29 14:33:31 -0700 |
| commit | 230739e45d7bf880f96d54d6608dba8524deac46 (patch) | |
| tree | 023e4bf388bac93cdd6079053739e729e5d18b81 | |
| parent | 0c7d1202a75fd046ecccb3dfaea85ba7176a75ad (diff) | |
| parent | 78698e9211ce642fb0ddeb63ce7d26339863d557 (diff) | |
| download | emacs-230739e45d7bf880f96d54d6608dba8524deac46.tar.gz | |
Merge remote-tracking branch 'origin/master' into athena/unstable
351 files changed, 6393 insertions, 4491 deletions
diff --git a/Makefile.in b/Makefile.in index bf0f52b514e..d288bacb9dd 100644 --- a/Makefile.in +++ b/Makefile.in @@ -51,7 +51,15 @@ # # make bootstrap # Removes all the compiled files to force a new bootstrap from a -# clean slate, and then build in the normal way. +# clean slate, and then build in the normal way. If the FAST Make +# variable is set, then the config.cache file isn't removed. This +# allows you to say +# +# ./configure -C +# make FAST=true bootstrap +# +# and use the cached results from the configure run, which is much +# faster. # # make docs # Make Emacs documentation files from their sources; requires makeinfo. @@ -358,10 +366,17 @@ endif gsettings_SCHEMAS = etc/org.gnu.emacs.defaults.gschema.xml -all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) +all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lisp .PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 epaths-force-ns-self-contained etc-emacsver +# Changes in lisp may require us to reconsider the build in src. For +# example, if loaddefs.{el,elc} were built in lisp, we need a new +# .pdmp containing the new autoloads. +.PHONY: src-depending-on-lisp +src-depending-on-lisp: lisp + ${MAKE} -C src BIN_DESTDIR='$(BIN_DESTDIR)' ELN_DESTDIR='$(ELN_DESTDIR)' + # If configure were to just generate emacsver.tex from emacsver.tex.in # in the normal way, the timestamp of emacsver.tex would always be # newer than that of the pdf files, which are prebuilt in release tarfiles. @@ -929,7 +944,7 @@ clean: $(clean_dirs:=_clean) clean-gsettings-schemas ### 'bootclean' ### Delete all files that need to be remade for a clean bootstrap. top_bootclean=\ - rm -f config.cache config.log ${srcdir}/doc/man/emacs.1 + rm -f config.log ${srcdir}/doc/man/emacs.1 ### 'distclean' ### Delete all files from the current directory that are created by @@ -939,7 +954,7 @@ top_bootclean=\ ### distribution. top_distclean=\ ${top_bootclean}; \ - rm -f config.status config.log~ \ + rm -f config.cache config.status config.log~ \ Makefile makefile lib/gnulib.mk ${SUBDIR_MAKEFILES} distclean_dirs = $(clean_dirs) leim lisp admin/grammars @@ -959,6 +974,9 @@ bootstrap-clean: $(distclean_dirs:=_bootstrap-clean) rm -rf ${srcdir}/info rm -f ${srcdir}/etc/refcards/emacsver.tex rm -rf native-lisp/ lisp/leim/ja-dic/ +ifndef FAST + rm -f config.cache +endif ${top_bootclean} ### 'maintainer-clean' diff --git a/admin/emake b/admin/emake index 548611c6afc..8b2114b3f8c 100755 --- a/admin/emake +++ b/admin/emake @@ -20,7 +20,7 @@ if [ -f /proc/cpuinfo ]; then sed 's/^[0-9]*/+/'))) fi -make -j$cores "$@" 2>&1 | \ +make FAST=true -j$cores "$@" 2>&1 | \ sed -u 's# \.\./\.\./# # s# \.\./# # s#^Configuring local git # Configuring local git # @@ -29,7 +29,7 @@ s#^Running # Running # s#^Configured for # Configured for # s#^./temacs.*# \\& # s#^make.*Error# \\& # -s#^Dumping under the name# \\& # +s#^Dumping under the name.*# \\& # ' | \ grep -E --line-buffered -v "^make|\ ^Loading|\ diff --git a/admin/gitmerge.el b/admin/gitmerge.el index a214dcbcb74..25bed949ad9 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -135,7 +135,7 @@ If nil, the function `gitmerge-default-branch' guesses.") (defun gitmerge-get-sha1 () "Get SHA1 from commit at point." (save-excursion - (goto-char (point-at-bol)) + (goto-char (line-beginning-position)) (when (looking-at "^[A-Z ]\\s-*\\([a-f0-9]+\\)") (match-string 1)))) @@ -187,7 +187,7 @@ If nil, the function `gitmerge-default-branch' guesses.") skip) (when commit (save-excursion - (goto-char (point-at-bol)) + (goto-char (line-beginning-position)) (when (looking-at "^\\([A-Z ]\\)\\s-*\\([a-f0-9]+\\)") (setq skip (string= (match-string 1) " ")) (goto-char (match-beginning 2)) @@ -195,7 +195,7 @@ If nil, the function `gitmerge-default-branch' guesses.") (dolist (ct gitmerge--commits) (when (string-match commit (car ct)) (setcdr ct (when skip "M")))) - (goto-char (point-at-bol)) + (goto-char (line-beginning-position)) (setq buffer-read-only nil) (delete-char 1) (insert (if skip "M" " ")) diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk index 5f392b5ad35..1c571feff38 100755 --- a/admin/unidata/blocks.awk +++ b/admin/unidata/blocks.awk @@ -224,9 +224,14 @@ FILENAME ~ "emoji-data.txt" && /^[0-9A-F].*; Emoji_Presentation / { END { idx = 0 - # ## These are here so that font_range can choose Emoji presentation - # ## for the preceding codepoint when it encounters a VS - override_start[idx] = "FE00" + ## This is here so that font_range can choose Emoji presentation + ## for the preceding codepoint when it encounters a VS-16 + ## (U+FE0F). See also font_range and the comments in composite.el + ## around the setup of `composition-function-table' for + ## U+FE00..U+FE0E. + ## It originally covered the whole FE00-FE0F range, but that + ## turned out to be a mistake. + override_start[idx] = "FE0F" override_end[idx] = "FE0F" for (k in override_start) diff --git a/config.bat b/config.bat index e9a180c8eed..4adc477bc95 100644 --- a/config.bat +++ b/config.bat @@ -301,6 +301,7 @@ If Exist sys_time.in.h update sys_time.in.h sys_time.in-h If Exist sys_types.in.h update sys_types.in.h sys_types.in-h
If Exist time.in.h update time.in.h time.in-h
If Exist unistd.in.h update unistd.in.h unistd.in-h
+If Exist stdckdint.in.h update stdckdint.in.h stdckdint.in-h
If Exist gnulib.mk.in update gnulib.mk.in gnulib.mk-in
Rem Only repository has the msdos/autogen directory
If Exist Makefile.in sed -f ../msdos/sedlibcf.inp < Makefile.in > makefile.tmp
diff --git a/configure.ac b/configure.ac index 1a264275bd4..4590ed3506e 100644 --- a/configure.ac +++ b/configure.ac @@ -2155,17 +2155,16 @@ AC_SUBST([NS_OBJ]) AC_SUBST([NS_OBJC_OBJ]) if test "${HAVE_NS}" = yes; then + AC_LANG_PUSH([Objective C]) AC_CACHE_CHECK( [if the Objective C compiler supports instancetype], [emacs_cv_objc_instancetype], - [AC_LANG_PUSH([Objective C]) - AC_COMPILE_IFELSE( + [AC_COMPILE_IFELSE( [AC_LANG_SOURCE([[@interface Test + (instancetype)test; @end]])], [emacs_cv_objc_instancetype=yes], - [emacs_cv_objc_instancetype=no]) - AC_LANG_POP([Objective C])]) + [emacs_cv_objc_instancetype=no])]) if test x$emacs_cv_objc_instancetype = xyes ; then AC_DEFINE([NATIVE_OBJC_INSTANCETYPE], [1], @@ -2175,16 +2174,15 @@ if test "${HAVE_NS}" = yes; then AC_CACHE_CHECK( [if the Objective C compiler defaults to C99], [emacs_cv_objc_c99], - [AC_LANG_PUSH([Objective C]) - AC_COMPILE_IFELSE( + [AC_COMPILE_IFELSE( [AC_LANG_PROGRAM([], [[for (int i = 0;;);]])], [emacs_cv_objc_c99=yes], - [emacs_cv_objc_c99=no]) - AC_LANG_POP([Objective C])]) + [emacs_cv_objc_c99=no])]) - if test x$emacs_cv_objc_c99 = xno ; then - GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -std=c99" - fi + if test x$emacs_cv_objc_c99 = xno ; then + GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -std=c99" + fi + AC_LANG_POP([Objective C]) fi HAVE_BE_APP=no @@ -2775,12 +2773,9 @@ if test "${with_webp}" != "no"; then || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes" \ || test "${HAVE_BE_APP}" = "yes" || test "${HAVE_PGTK}" = "yes"; then WEBP_REQUIRED=0.6.0 - WEBP_MODULE="libwebp >= $WEBP_REQUIRED" + WEBP_MODULE="libwebpdemux >= $WEBP_REQUIRED" EMACS_CHECK_MODULES([WEBP], [$WEBP_MODULE]) - if test "$HAVE_WEBP" = "yes"; then - WEBP_LIBS="-lwebp -lwebpdemux" - fi AC_SUBST([WEBP_CFLAGS]) AC_SUBST([WEBP_LIBS]) fi @@ -4240,8 +4235,8 @@ if test "${with_native_compilation}" != "no"; then if test -n "`$BREW --prefix --installed libgccjit 2>/dev/null`"; then MAC_CFLAGS="-I$(dirname $($BREW ls -v libgccjit | \ grep libgccjit.h))" - MAC_LIBS="-L$(dirname $($BREW ls -v libgccjit| \ - grep -E 'libgccjit\.(so|dylib)$'))" + MAC_LIBS="-L$(dirname $($BREW ls -v libgccjit \ + | grep -m1 -E 'libgccjit\.(so|dylib)$'))" fi fi diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index efaf0dfd382..ff7ab83190c 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -2303,6 +2303,8 @@ as a function from Lisp programs. @cindex startup (init file) @cindex XDG_CONFIG_HOME +@c When updating this, also update ``Setting up a customization file'' +@c in efaq.texi. When Emacs is started, it normally tries to load a Lisp program from an @dfn{initialization file}, or @dfn{init file} for short. This file, if it exists, specifies how to initialize Emacs for you. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 292c986c1c6..33e9270d42d 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -41,6 +41,7 @@ you to operate on the listed files. @xref{Directories}. * Operating on Files:: How to copy, rename, print, compress, etc. either one file or several files. * Shell Commands in Dired:: Running a shell command on the marked files. +* Shell Command Guessing:: Guessing shell commands for files. * Transforming File Names:: Using patterns to rename multiple files. * Comparison in Dired:: Running @code{diff} by way of Dired. * Subdirectories in Dired:: Adding subdirectories to the Dired buffer. @@ -1121,6 +1122,73 @@ buffer (@pxref{Dired Updating}). @xref{Single Shell}, for information about running shell commands outside Dired. +@node Shell Command Guessing +@section Shell Command Guessing +@cindex guessing shell commands for files (in Dired) + +Based upon the name of a file, Dired tries to guess what shell command +you might want to apply to it. For example, if you have point on a +file named @file{foo.tar} and you press @kbd{!}, Dired will guess that +you want to run @samp{tar xvf}, and suggest that as the default shell +command. + +You can type @kbd{M-n} to get the default into the minibuffer for +editing. If there are several commands for a given file, type +@kbd{M-n} several times to see each matching command in order. + +Dired only tries to guess a command for a single file, never for a +list of marked files. + +@defvar dired-guess-shell-alist-default +This variable specifies the predefined rules for guessing shell +commands suitable for certain files. Set this to @code{nil} to turn +guessing off. The elements of @code{dired-guess-shell-alist-user} +(defined by the user) will override these rules. +@end defvar + +@defvar dired-guess-shell-alist-user +If non-@code{nil}, this variable specifies the user-defined alist of +file regexps and their suggested commands. These rules take +precedence over the predefined rules in the variable +@code{dired-guess-shell-alist-default} when +@code{dired-do-shell-command} is run). The default is @code{nil}. + +Each element of the alist looks like + +@example +(@var{regexp} @var{command}@dots{}) +@end example + +@noindent +where each @var{command} can either be a string or a Lisp expression +that evaluates to a string. If several commands are given, all of +them will temporarily be pushed onto the history. + +A @samp{*} in the shell command stands for the file name that matched +@var{regexp}. When Emacs invokes the @var{command}, it replaces each +instance of @samp{*} with the matched file name. + +To add rules for @samp{.foo} and @samp{.bar} file extensions, add this +to your Init file: + +@example +(setq dired-guess-shell-alist-user + (list + (list "\\.foo$" "@var{foo-command}") ; fixed rule + ;; possibly more rules... + (list "\\.bar$" ; rule with condition test + '(if @var{condition} + "@var{bar-command-1}" + "@var{bar-command-2}")))) +@end example + +@noindent +This will override any predefined rules for the same extensions. +@end defvar + +You can find more user options with @kbd{M-x customize-group @key{RET} +dired-guess @key{RET}}. + @node Transforming File Names @section Transforming File Names in Dired diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 404978b315d..5b3b15cd38f 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -2273,12 +2273,14 @@ behavior by using the options @code{image-auto-resize} and @findex image-transform-set-scale @findex image-transform-reset To resize the image manually you can use the command -@code{image-transform-fit-to-window} bound to @kbd{s w} -that fits the image to both the window height and width. -To scale the image specifying a scale factor, use the command -@code{image-transform-set-scale} bound to @kbd{s s}. -To reset all transformations to the initial state, use -@code{image-transform-reset} bound to @kbd{s 0}. +@code{image-transform-fit-to-window} bound to @kbd{s w} that fits the +image to both the window height and width. To scale the image to a +percentage of its original size, use the command +@code{image-transform-set-percent} bound to @kbd{s p}. To scale +the image specifying a scale factor, use the command +@code{image-transform-set-scale} bound to @kbd{s s}. To reset all +transformations to the initial state, use @code{image-transform-reset} +bound to @kbd{s 0}. @findex image-next-file @findex image-previous-file diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index e00edeb392b..47a5a870fde 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -14808,7 +14808,7 @@ symbols in one function definition." (setq lengths-list (cons (count-words-in-defun) lengths-list))) (kill-buffer buffer) - lengths-list)))) + lengths-list))) @end group @end smallexample diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 26739bf5b8d..ede1c4d7622 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -443,9 +443,9 @@ specification. If the key sequence that invoked the command has and @acronym{ASCII} characters, do not count where @samp{e} is concerned. @item f -A file name of an existing file (@pxref{File Names}). The default -directory is @code{default-directory}. Existing, Completion, Default, -Prompt. +A file name of an existing file (@pxref{File Names}). @xref{Reading +File Names}, for details about default values. Existing, Completion, +Default, Prompt. @item F A file name. The file need not exist. Completion, Default, Prompt. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index d336cda6743..db58cd14c63 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2623,14 +2623,17 @@ Draw a box with lines of width 1, in the foreground color. Draw a box with lines of width 1, in color @var{color}. @item @code{(:line-width (@var{vwidth} . @var{hwidth}) :color @var{color} :style @var{style})} -This way you can explicitly specify all aspects of the box. The values -@var{vwidth} and @var{hwidth} specifies respectively the width of the -vertical and horizontal lines to draw; they default to (1 . 1). -A negative horizontal or vertical width @minus{}@var{n} means to draw a line -of width @var{n} that occupies the space of the underlying text, thus -avoiding any increase in the character height or width. For simplification -the width could be specified with only a single number @var{n} instead -of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}. +You can explicitly specify all aspects of the box with a plist on this +form. Any element in this plist can be omitted. + +The values @var{vwidth} and @var{hwidth} specifies respectively the +width of the vertical and horizontal lines to draw; they default to (1 +. 1). A negative horizontal or vertical width @minus{}@var{n} means +to draw a line of width @var{n} that occupies the space of the +underlying text, thus avoiding any increase in the character height or +width. For simplification the width could be specified with only a +single number @var{n} instead of a list, such case is equivalent to +@code{((abs @var{n}) . @var{n})}. The value @var{style} specifies whether to draw a 3D box. If it is @code{released-button}, the box looks like a 3D button that is not @@ -5886,6 +5889,14 @@ When you click the mouse when the mouse pointer is over a hot-spot, an event is composed by combining the @var{id} of the hot-spot with the mouse event; for instance, @code{[area4 mouse-1]} if the hot-spot's @var{id} is @code{area4}. + +Note that the map's coordinates should reflect the displayed image +after all transforms have been done (rotation, scaling and so on), and +also note that Emacs (by default) performs auto-scaling of images, so +to make things match up, you should either specify @code{:scale 1.0} +when creating the image, or use the result of +@code{image-compute-scaling-factor} to compute the elements of the +map. @end table @defun image-mask-p spec &optional frame @@ -8531,7 +8542,11 @@ hexadecimal notation. @item an @acronym{ASCII} string Display a box containing that string. The string should contain at -most 6 @acronym{ASCII} characters. +most 6 @acronym{ASCII} characters. As an exception, if the string +includes just one character, on text-mode terminals that character +will be displayed without a box; this allows to handle such +``acronyms'' as a replacement character for characters that cannot be +displayed by the terminal. @item a cons cell @code{(@var{graphical} . @var{text})} Display with @var{graphical} on graphical displays, and with @@ -8548,7 +8563,7 @@ square brackets, @samp{[]}. The char-table has one extra slot, which determines how to display any character that cannot be displayed with any available font, or cannot be encoded by the terminal's coding system. Its value should be one -of the above display methods, except @code{zero-width} or a cons cell. +of the above display methods, except @code{zero-width}. If a character has a non-@code{nil} entry in an active display table, the display table takes effect; in this case, Emacs does not consult diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 333c8e19a0e..7945232bf8f 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -387,6 +387,16 @@ Return the position that @code{(end-of-line @var{count})} would move to. @end defun +@defun pos-bol &optional count +Like @code{line-beginning-position}, but ignores fields (and is more +efficient). +@end defun + +@defun pos-eol &optional count +Like @code{line-end-position}, but ignores fields (and is more +efficient). +@end defun + @deffn Command forward-line &optional count @cindex beginning of line This function moves point forward @var{count} lines, to the beginning of diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index c2161b9341d..8b859042ad0 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5473,12 +5473,15 @@ available in this Emacs session. When libxml2 support is available, the following functions can be used to parse HTML or XML text into Lisp object trees. -@defun libxml-parse-html-region start end &optional base-url discard-comments +@defun libxml-parse-html-region &optional start end base-url discard-comments This function parses the text between @var{start} and @var{end} as HTML, and returns a list representing the HTML @dfn{parse tree}. It attempts to handle real-world HTML by robustly coping with syntax mistakes. +If @var{start} or @var{end} are @code{nil}, they default to the values +from @code{point-min} and @code{point-max}, respectively. + The optional argument @var{base-url}, if non-@code{nil}, should be a string specifying the base URL for relative URLs occurring in links. @@ -5524,7 +5527,7 @@ buffer. The argument @var{dom} should be a list as generated by @end defun @cindex parsing xml -@defun libxml-parse-xml-region start end &optional base-url discard-comments +@defun libxml-parse-xml-region &optional start end base-url discard-comments This function is the same as @code{libxml-parse-html-region}, except that it parses the text as XML rather than HTML (so it is stricter about syntax). diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 242b1a3be93..80d6a01412b 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2679,17 +2679,46 @@ cdar nthcdr A call to any of the following Emacs-specific functions: @smallexample -alist-get process-get -frame-parameter process-sentinel -terminal-parameter window-buffer -keymap-parent window-display-table -match-data window-dedicated-p -overlay-get window-hscroll -overlay-start window-parameter -overlay-end window-point -process-buffer window-start -process-filter default-value +alist-get overlay-start +default-value overlay-get +face-background process-buffer +face-font process-filter +face-foreground process-get +face-stipple process-sentinel +face-underline-p terminal-parameter +file-modes window-buffer +frame-parameter window-dedicated-p +frame-parameters window-display-table +get-register window-hscroll +getenv window-parameter +keymap-parent window-point +match-data window-start +overlay-end @end smallexample + +@item +A call of the form @code{(substring @var{subplace} @var{n} [@var{m}])}, +where @var{subplace} is itself a valid generalized variable whose +current value is a string, and where the value stored is also a +string. The new string is spliced into the specified part of the +destination string. For example: + +@example +(setq a (list "hello" "world")) + @result{} ("hello" "world") +(cadr a) + @result{} "world" +(substring (cadr a) 2 4) + @result{} "rl" +(setf (substring (cadr a) 2 4) "o") + @result{} "o" +(cadr a) + @result{} "wood" +a + @result{} ("hello" "wood") +@end example + +@c FIXME? Also 'eq'? (see gv.el) @end itemize @noindent @@ -2822,6 +2851,16 @@ expression manipulating @var{place} via @var{getter} and @var{setter}. Consult the source file @file{gv.el} for more details. +@defun make-obsolete-generalized-variable obsolete-name current-name when +This function makes the byte compiler warn that the generalized +variable @var{obsolete-name} is obsolete. If @var{current-name} is a +symbol, then the warning message says to use @var{current-name} +instead of @var{obsolete-name}. If @var{current-name} is a string, +this is the message. @var{when} should be a string indicating when +the variable was first made obsolete (usually a version number +string). +@end defun + @cindex CL note---no @code{setf} functions @quotation @b{Common Lisp note:} Common Lisp defines another way to specify the diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 91a9afd9c9f..9dc63af6bcc 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -384,7 +384,7 @@ This function creates a new item in @var{collection} with label @var{item} and password @var{password}. The label @var{item} does not have to be unique in @var{collection}. @var{attributes} are key-value pairs set for the created item. The keys are keyword symbols, -starting with a colon. Example: +starting with a colon; values are strings. Example: @example ;;; The collection is "session", the label is "my item" @@ -466,6 +466,10 @@ then fall back to @file{~/.authinfo.gpg}. "~/.authinfo.gpg")) @end example +Attribute values in the auth-source spec, which are not strings (like +port numbers), are stringified prior calling the @file{secrets.el} +functions. + @node The Unix password store @chapter The Unix password store diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 07c19e37ce4..a6747b1096a 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -920,69 +920,6 @@ cl-caaar@dots{}cl-cddddr cl-first@dots{}cl-tenth Note that for @code{cl-getf} (as for @code{nthcdr}), the list argument of the function must itself be a valid @var{place} form. -@item -General Emacs Lisp functions: -@example -buffer-file-name getenv -buffer-modified-p global-key-binding -buffer-name local-key-binding -buffer-string mark -buffer-substring mark-marker -current-buffer marker-position -current-case-table mouse-position -current-column point -current-global-map point-marker -current-input-mode point-max -current-local-map point-min -current-window-configuration read-mouse-position -default-file-modes screen-height -documentation-property screen-width -face-background selected-window -face-background-pixmap selected-screen -face-font selected-frame -face-foreground standard-case-table -face-underline-p syntax-table -file-modes visited-file-modtime -frame-height window-height -frame-parameters window-width -frame-visible-p x-get-secondary-selection -frame-width x-get-selection -get-register -@end example - -Most of these have directly corresponding ``set'' functions, like -@code{use-local-map} for @code{current-local-map}, or @code{goto-char} -for @code{point}. A few, like @code{point-min}, expand to longer -sequences of code when they are used with @code{setf} -(@code{(narrow-to-region x (point-max))} in this case). - -@item -A call of the form @code{(substring @var{subplace} @var{n} [@var{m}])}, -where @var{subplace} is itself a valid generalized variable whose -current value is a string, and where the value stored is also a -string. The new string is spliced into the specified part of the -destination string. For example: - -@example -(setq a (list "hello" "world")) - @result{} ("hello" "world") -(cadr a) - @result{} "world" -(substring (cadr a) 2 4) - @result{} "rl" -(setf (substring (cadr a) 2 4) "o") - @result{} "o" -(cadr a) - @result{} "wood" -a - @result{} ("hello" "wood") -@end example - -The generalized variable @code{buffer-substring}, listed above, -also works in this way by replacing a portion of the current buffer. - -@c FIXME? Also 'eq'? (see cl-lib.el) - @c Currently commented out in cl.el. @ignore @item @@ -1381,19 +1318,10 @@ bar A @code{setq} of a symbol macro is treated the same as a @code{setf}. I.e., @code{(setq foo 4)} in the above would be equivalent to -@code{(setf foo 4)}, which in turn expands to @code{(setf (car bar) 4)}. - -Likewise, a @code{let} or @code{let*} binding a symbol macro is -treated like a @code{cl-letf} or @code{cl-letf*}. This differs from true -Common Lisp, where the rules of lexical scoping cause a @code{let} -binding to shadow a @code{symbol-macrolet} binding. In this package, -such shadowing does not occur, even when @code{lexical-binding} is -@c See https://debbugs.gnu.org/12119 -@code{t}. (This behavior predates the addition of lexical binding to -Emacs Lisp, and may change in future to respect @code{lexical-binding}.) -At present in this package, only @code{lexical-let} and -@code{lexical-let*} will shadow a symbol macro. @xref{Obsolete -Lexical Binding}. +@code{(setf foo 4)}, which in turn expands to @code{(setf (car bar) +4)}. A @code{let} (or @code{let*}, @code{lambda}, ...) binding of +the same symbol will locally shadow the symbol macro as is the case in +Common Lisp. There is no analogue of @code{defmacro} for symbol macros; all symbol macros are local. A typical use of @code{cl-symbol-macrolet} is in the diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 50d9914081c..002164ed91f 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -92,7 +92,6 @@ For @file{dired-x.el} as distributed with GNU Emacs @value{EMACSVER}. * Introduction:: * Installation:: * Omitting Files in Dired:: -* Shell Command Guessing:: * Virtual Dired:: * Advanced Mark Commands:: * Multiple Dired Directories:: @@ -135,9 +134,6 @@ Some features provided by Dired Extra: Omitting uninteresting files from Dired listing (@pxref{Omitting Files in Dired}). @item -Guessing shell commands in Dired buffers -(@pxref{Shell Command Guessing}). -@item Running Dired command in non-Dired buffers (@pxref{Virtual Dired}). @item @@ -165,8 +161,6 @@ When @file{dired-x.el} is loaded, some standard Dired functions from Dired}), if it is active. @code{dired-find-buffer-nocreate} and @code{dired-initial-position} respect the value of @code{dired-find-subdir} (@pxref{Miscellaneous Commands}). -@code{dired-read-shell-command} uses @code{dired-guess-shell-command} -(@pxref{Shell Command Guessing}) to offer a smarter default command. @node Installation @chapter Installation @@ -184,7 +178,6 @@ In your @file{~/.emacs} file, or in the system-wide initialization file (with-eval-after-load 'dired (require 'dired-x) ;; Set dired-x global variables here. For example: - ;; (setq dired-guess-shell-gnutar "gtar") ;; (setq dired-x-hands-off-my-keys nil) )) (add-hook 'dired-mode-hook @@ -436,111 +429,6 @@ Loading @file{dired-x.el} will install Dired Omit by putting call @code{dired-extra-startup}, which in turn calls @code{dired-omit-startup} in your @code{dired-mode-hook}. -@node Shell Command Guessing -@chapter Shell Command Guessing -@cindex guessing shell commands for files. - -Based upon the name of a file, Dired tries to guess what shell -command you might want to apply to it. For example, if you have point -on a file named @file{foo.tar} and you press @kbd{!}, Dired will guess -you want to @samp{tar xvf} it and suggest that as the default shell -command. - -The default is mentioned in brackets and you can type @kbd{M-n} to get -the default into the minibuffer and then edit it, e.g., to change -@samp{tar xvf} to @samp{tar tvf}. If there are several commands for a given -file, e.g., @samp{xtex} and @samp{dvips} for a @file{.dvi} file, you can type -@kbd{M-n} several times to see each of the matching commands. - -Dired only tries to guess a command for a single file, never for a list -of marked files. - -The following variables control guessing of shell commands: - -@defvar dired-guess-shell-alist-default -This variable specifies the predefined rules for guessing shell -commands suitable for certain files. Set this to @code{nil} to turn -guessing off. The elements of @code{dired-guess-shell-alist-user} -(defined by the user) will override these rules. -@end defvar - -@defvar dired-guess-shell-alist-user -If non-@code{nil}, this variables specifies the user-defined alist of -file regexps and their suggested commands. These rules take -precedence over the predefined rules in the variable -@code{dired-guess-shell-alist-default} (to which they are prepended) -when @code{dired-do-shell-command} is run). The default is -@code{nil}. - -Each element of the alist looks like - -@example -(@var{regexp} @var{command}@dots{}) -@end example - -@noindent -where each @var{command} can either be a string or a Lisp expression -that evaluates to a string. If several commands are given, all of -them will temporarily be pushed onto the history. - -A @samp{*} in the shell command stands for the file name that matched -@var{regexp}. When Emacs invokes the @var{command}, it replaces each -instance of @samp{*} with the matched file name. - -You can set this variable in your @file{~/.emacs}. For example, -to add rules for @samp{.foo} and @samp{.bar} file extensions, write - -@example -(setq dired-guess-shell-alist-user - (list - (list "\\.foo$" "@var{foo-command}");; fixed rule - ;; possibly more rules... - (list "\\.bar$";; rule with condition test - '(if @var{condition} - "@var{bar-command-1}" - "@var{bar-command-2}")))) -@end example - -@noindent -This will override any predefined rules for the same extensions. -@end defvar - -@defvar dired-guess-shell-case-fold-search -If this variable is non-@code{nil}, -@code{dired-guess-shell-alist-default} and -@code{dired-guess-shell-alist-user} are matched case-insensitively. -The default is @code{t}. -@end defvar - -@cindex passing GNU Tar its @samp{z} switch. -@defvar dired-guess-shell-gnutar -If this variable is non-@code{nil}, it specifies the name of the GNU -Tar executable (e.g., @file{tar} or @file{gnutar}). GNU Tar's -@samp{z} switch is used for compressed archives. If you don't have -GNU Tar, set this to @code{nil}: a pipe using @command{zcat} is then -used instead. The default is @code{nil}. -@end defvar - -@cindex @code{gzip} -@defvar dired-guess-shell-gzip-quiet -A non-@code{nil} value of this variable means that @samp{-q} is passed -to @command{gzip}, possibly overriding a verbose option in the @env{GZIP} -environment variable. The default is @code{t}. -@end defvar - -@cindex @code{znew} -@defvar dired-guess-shell-znew-switches nil -This variable specifies a string of switches passed to @command{znew}. -An example is @samp{-K} which will make @command{znew} keep a @file{.Z} -file when it is smaller than the @file{.gz} file. The default is -@code{nil}: no additional switches are passed to @command{znew}. -@end defvar - -@defvar dired-shell-command-history nil -This variable holds the history list for commands that read -dired-shell commands. -@end defvar - @node Virtual Dired @chapter Virtual Dired diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index c29e4fe4875..a3459abd041 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -27,9 +27,6 @@ latest version of the FAQ is archived. The FAQ may be copied and redistributed under these conditions, except that the FAQ may not be embedded in a larger literary work unless that work itself allows free copying and redistribution. - -[This version has been heavily edited since it was included in the Emacs -distribution in 1999.] @end quotation @end copying @@ -545,11 +542,11 @@ printed manual}. @cindex Reference cards, in other languages @item You can get a printed reference card listing commands and keys to -invoke them. You can order one from the FSF for $2 (or 10 for $18), -or you can print your own from the @file{etc/refcards/refcard.tex} or -@file{etc/refcards/refcard.pdf} files in the Emacs distribution. -The Emacs distribution comes with translations of the reference card -into several languages; look for files named +invoke them. You can order one from the FSF, or you can print your +own from the @file{etc/refcards/refcard.tex} or +@file{etc/refcards/refcard.pdf} files in the Emacs distribution. The +Emacs distribution comes with translations of the reference card into +several languages; look for files named @file{etc/refcards/@var{lang}-refcard.*}, where @var{lang} is a two-letter code of the language. For example, the German version of the reference card is in the files @file{etc/refcards/de-refcard.tex} @@ -696,9 +693,10 @@ of the file in parentheses, like this: @item You can create your own Info directory. You can tell Emacs where that Info directory is by adding its pathname to the value of the variable -@code{Info-default-directory-list}. For example, to use a private Info -directory which is a subdirectory of your home directory named @file{Info}, -you could put this in your @file{.emacs} file: +@code{Info-default-directory-list}. For example, to use a private +Info directory which is a subdirectory of your home directory named +@file{Info}, you could put this in your init file (@pxref{Setting up a +customization file}): @lisp (add-to-list 'Info-default-directory-list "~/Info/") @@ -1607,35 +1605,38 @@ is better to write ``Emacs and XEmacs.'' @end menu @node Setting up a customization file -@section How do I set up a @file{.emacs} file properly? +@section How do I set up an init file properly? @cindex @file{.emacs} file, setting up -@cindex @file{.emacs} file, locating +@cindex @file{.emacs.d/init.el} file, setting up @cindex Init file, setting up +@cindex Init file, locating @cindex Customization file, setting up +When Emacs is started, it normally tries to load a Lisp program from +an @dfn{initialization file}, or @dfn{init file} for short. This +file, if it exists, specifies how to initialize Emacs for you. +Traditionally, file @file{~/.emacs} is used as the init file, although +Emacs also looks at @file{~/.emacs.el}, @file{~/.emacs.d/init.el}, +@file{~/.config/emacs/init.el}, or other locations. @xref{Init File,,, emacs, The GNU Emacs Manual}. -In general, new Emacs users should not be provided with @file{.emacs} -files, because this can cause confusing non-standard behavior. Then -they send questions to -@url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs, -the help-gnu-emacs mailing list} asking why Emacs -isn't behaving as documented. - Emacs includes the Customize facility (@pxref{Using Customize}). This allows users who are unfamiliar with Emacs Lisp to modify their -@file{.emacs} files in a relatively straightforward way, using menus +init files in a relatively straightforward way, using menus rather than Lisp code. While Customize might indeed make it easier to configure Emacs, consider taking a bit of time to learn Emacs Lisp and modifying your -@file{.emacs} directly. Simple configuration options are described +init file directly. Simple configuration options are described rather completely in @ref{Init File,,, emacs, The GNU Emacs Manual}, for users interested in performing frequently requested, basic tasks. -Sometimes users are unsure as to where their @file{.emacs} file should -be found. Visiting the file as @file{~/.emacs} from Emacs will find -the correct file. +In general, new Emacs users should not be provided with init +files, because this can cause confusing non-standard behavior. Then +they send questions to +@url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs, +the help-gnu-emacs mailing list} asking why Emacs +isn't behaving as documented. @node Using Customize @section How do I start using Customize? @@ -1743,21 +1744,22 @@ always use custom terminal definition with @samp{setb24} and @samp{setf24}. @node Debugging a customization file -@section How do I debug a @file{.emacs} file? -@cindex Debugging @file{.emacs} file -@cindex @file{.emacs} debugging +@section How do I debug an init file? +@cindex Debugging @file{.emacs.d/init.el} file +@cindex Debugging init file +@cindex @file{.emacs.d/init.el} debugging @cindex Init file debugging @cindex @samp{-debug-init} option Start Emacs with the @samp{-debug-init} command-line option. This -enables the Emacs Lisp debugger before evaluating your @file{.emacs} +enables the Emacs Lisp debugger before evaluating your init file, and places you in the debugger if something goes wrong. The top line in the @file{trace-back} buffer will be the error message, and the second or third line of that buffer will display the Lisp code from your -@file{.emacs} file that caused the problem. +init file that caused the problem. You can also evaluate an individual function or argument to a function -in your @file{.emacs} file by moving the cursor to the end of the +in your init file by moving the cursor to the end of the function or argument and typing @kbd{C-x C-e} (@kbd{M-x eval-last-sexp}). @@ -1787,7 +1789,8 @@ You can similarly display the current column with @end lisp @noindent -in your @file{.emacs} file. This feature is off by default. +in your init file (@pxref{Setting up a customization file}). This +feature is off by default. The @code{"%c"} format specifier in the variable @code{mode-line-format} will insert the current column's value into the mode line. See the @@ -1806,9 +1809,8 @@ optional display. Alternatively, you can use the customize @code{display-line-numbers-type} with the same value as you would use with @code{display-line-numbers}. -There is also the @samp{linum} package (distributed with Emacs since -version 23.1) which will henceforth become obsolete. Users and -developers are encouraged to use @samp{display-line-numbers} instead. +There is also the @samp{linum} package which will henceforth become +obsolete. We recommend using @samp{display-line-numbers} instead. @node Displaying the current file name in the titlebar @section How can I modify the titlebar to contain the current file name? @@ -1834,7 +1836,7 @@ machine at which Emacs was invoked. This is done by setting To modify the behavior such that frame titlebars contain the buffer's name regardless of the number of existing frames, include the following -in your @file{.emacs}: +in your init file (@pxref{Setting up a customization file}): @lisp (setq frame-title-format "%b") @@ -1844,9 +1846,10 @@ in your @file{.emacs}: @section How do I turn on abbrevs by default just in mode @var{mymode}? @cindex Abbrevs, turning on by default -Abbrev mode expands abbreviations as you type them. To turn it on in a -specific buffer, use @kbd{M-x abbrev-mode}. To turn it on in every -buffer by default, put this in your @file{.emacs} file: +Abbrev mode expands abbreviations as you type them. To turn it on in +a specific buffer, use @kbd{M-x abbrev-mode}. To turn it on in every +buffer by default, put this in your init file (@pxref{Setting up a +customization file}): @lisp (setq-default abbrev-mode t) @@ -1896,7 +1899,8 @@ the script. Use @kbd{C-h v} (or @kbd{M-x describe-variable}) on @cindex Highlighting and replacing text Use @code{delete-selection-mode}, which you can start automatically by -placing the following Lisp form in your @file{.emacs} file: +placing the following Lisp form in your init file (@pxref{Setting up a +customization file}): @lisp (delete-selection-mode 1) @@ -2034,9 +2038,10 @@ The default maximum line width is 70, determined by the variable To turn on @code{auto-fill-mode} just once for one buffer, use @kbd{M-x auto-fill-mode}. -To turn it on for every buffer in a certain mode, you must use the hook -for that mode. For example, to turn on @code{auto-fill} mode for all -text buffers, including the following in your @file{.emacs} file: +To turn it on for every buffer in a certain mode, you must use the +hook for that mode. For example, to turn on @code{auto-fill} mode for +all text buffers, including the following in your init file +(@pxref{Setting up a customization file}): @lisp (add-hook 'text-mode-hook 'turn-on-auto-fill) @@ -2091,7 +2096,8 @@ option: emacs -f server-start @end example -or by invoking @code{server-start} from @file{.emacs}: +or by invoking @code{server-start} from init file (@pxref{Setting up a +customization file}): @lisp (if (@var{some conditions are met}) (server-start)) @@ -2162,7 +2168,8 @@ f() @} @end example -@noindent To achieve this, add the following line to your @file{.emacs}: +@noindent To achieve this, add the following line to your init file +(@pxref{Setting up a customization file}): @lisp (c-set-offset 'case-label '+) @@ -2213,7 +2220,8 @@ the line or the block according to what you just specified. @item If you don't like the result, go back to step 1. Otherwise, add the -following line to your @file{.emacs}: +following line to your init file (@pxref{Setting up a customization +file}): @lisp (c-set-offset '@var{syntactic-symbol} @var{offset}) @@ -2243,8 +2251,8 @@ customizations inside a C mode hook, like this: @noindent Using @code{c-mode-hook} avoids the need to put a @w{@code{(require -'cc-mode)}} into your @file{.emacs} file, because @code{c-set-offset} -might be unavailable when @code{cc-mode} is not loaded. +'cc-mode)}} into your init file, because @code{c-set-offset} might be +unavailable when @code{cc-mode} is not loaded. Note that @code{c-mode-hook} runs for C source files only; use @code{c++-mode-hook} for C@t{++} sources, @code{java-mode-hook} for @@ -2316,8 +2324,8 @@ usage: xset [-display host:dpy] option ... @cindex Previous line, indenting according to @cindex Text indentation -Such behavior is automatic (in Text mode) in Emacs 20 and later. From the -@file{etc/NEWS} file for Emacs 20.2: +Such behavior is automatic (in Text mode). From the @file{etc/NEWS} +file for Emacs 20.2: @example ** In Text mode, now only blank lines separate paragraphs. This makes @@ -2355,7 +2363,8 @@ new paragraph. There are many packages available to deal with this @cindex Pairs of parentheses, highlighting @cindex Matching parentheses -Call @code{show-paren-mode} in your @file{.emacs} file: +Call @code{show-paren-mode} in your init file (@pxref{Setting up a +customization file}): @lisp (show-paren-mode 1) @@ -2460,8 +2469,9 @@ Emacs Lisp @dfn{form}: @item If you want it evaluated every time you run Emacs, put it in a file -named @file{.emacs} in your home directory. This is known as ``your -@file{.emacs} file,'' and contains all of your personal customizations. +named @file{.emacs.d/init.el} in your home directory. This is known +as ``your init file,'' and contains all of your personal +customizations (@pxref{Setting up a customization file}). @item You can type the form in the @file{*scratch*} buffer, and then type @@ -2499,7 +2509,7 @@ about them. Set the default value of the variable @code{tab-width}. For example, to set @key{TAB} stops every 10 characters, insert the following in your -@file{.emacs} file: +init file (@pxref{Setting up a customization file}): @lisp (setq-default tab-width 10) @@ -2641,8 +2651,9 @@ Quick command-line switch descriptions are also available. For example, You probably don't want to do this, since backups are useful, especially when something goes wrong. -To avoid seeing backup files (and other ``uninteresting'' files) in Dired, -load @code{dired-x} by adding the following to your @file{.emacs} file: +To avoid seeing backup files (and other ``uninteresting'' files) in +Dired, load @code{dired-x} by adding the following to your init file +(@pxref{Setting up a customization file}): @lisp (with-eval-after-load 'dired @@ -2651,7 +2662,7 @@ load @code{dired-x} by adding the following to your @file{.emacs} file: With @code{dired-x} loaded, @kbd{C-x M-o} toggles omitting in each dired buffer. You can make omitting the default for new dired buffers by putting the -following in your @file{.emacs}: +following in your init file: @lisp (add-hook 'dired-mode-hook 'dired-omit-mode) @@ -2905,17 +2916,18 @@ Different levels of decoration are available, from slight to gaudy. More decoration means you need to wait more time for a buffer to be fontified (or a faster machine). To control how decorated your buffers should become, set the value of -@code{font-lock-maximum-decoration} in your @file{.emacs} file, with a -@code{nil} value indicating default (usually minimum) decoration, and a -@code{t} value indicating the maximum decoration. For the gaudiest -possible look, then, include the line +@code{font-lock-maximum-decoration} in your init file (@pxref{Setting +up a customization file}), with a @code{nil} value indicating default +(usually minimum) decoration, and a @code{t} value indicating the +maximum decoration. For the gaudiest possible look, then, include the +line @lisp (setq font-lock-maximum-decoration t) @end lisp @noindent -in your @file{.emacs} file. You can also set this variable such that +in your init file. You can also set this variable such that different modes are highlighted in a different ways; for more information, see the documentation for @code{font-lock-maximum-decoration} with @kbd{C-h v} (or @kbd{M-x @@ -2942,7 +2954,8 @@ customize-variable @key{RET} scroll-conservatively @key{RET}} and set it to a large value like, say, 10000. For an explanation of what this means, @pxref{Auto Scrolling,,, emacs, The GNU Emacs Manual}. -Alternatively, use the following Lisp form in your @file{.emacs}: +Alternatively, use the following Lisp form in your init file +(@pxref{Setting up a customization file}): @lisp (setq scroll-conservatively most-positive-fixnum) @@ -2971,7 +2984,8 @@ default, a backslash (@samp{\}) will appear in the mode line. @cindex Single space following periods @cindex Periods, one space following -Add the following line to your @file{.emacs} file: +Add the following line to your init file (@pxref{Setting up a +customization file}): @lisp (setq sentence-end-double-space nil) @@ -2993,15 +3007,15 @@ escape sequences. It is enabled by default. @cindex Fullscreen mode Beginning with Emacs 24.4 either run Emacs with the @samp{--maximized} -command-line option or put the following form in your @file{.emacs} -file: +command-line option or put the following form in your init file +(@pxref{Setting up a customization file}): @lisp (add-hook 'emacs-startup-hook 'toggle-frame-maximized) @end lisp With older versions use the function @code{w32-send-sys-command}. For -example, you can put the following in your @file{.emacs} file: +example, you can put the following in your init file: @lisp (add-hook 'emacs-startup-hook @@ -3059,10 +3073,9 @@ Emacs has an inherent fixed limitation on the size of buffers. This limit is stricter than the maximum size of objects supported by other programs on the same architecture. -The maximum buffer size on 32-bit machines is 512 MBytes beginning -with version 23.2. If Emacs was built using the -@code{--with-wide-int} flag, the maximum buffer size on 32-bit -machines is 2 GB. +The maximum buffer size on 32-bit machines is 512 MBytes. If Emacs +was built using the @code{--with-wide-int} flag, the maximum buffer +size on 32-bit machines is 2 GB. Emacs compiled on a 64-bit machine can handle much larger buffers; up to @code{most-positive-fixnum} (2.3 exabytes). @@ -3126,8 +3139,8 @@ with the following Lisp form, The above solutions try to prevent the shell from producing the @samp{^M} characters in the first place. If this is not possible (e.g., if you use a Windows shell), you can get Emacs to remove these -characters from the buffer by adding this to your @file{.emacs} init -file: +characters from the buffer by adding this to your init file +(@pxref{Setting up a customization file}): @smalllisp (add-hook 'comint-output-filter-functions #'comint-strip-ctrl-m) @@ -3149,8 +3162,8 @@ stty -icrnl -onlcr -echo susp ^Z @cindex @code{explicit-shell-file-name} This might happen because Emacs tries to look for the shell in a wrong place. If you know where your shell executable is, set the variable -@code{explicit-shell-file-name} in your @file{.emacs} file to point to -its full file name. +@code{explicit-shell-file-name} in your init file (@pxref{Setting up a +customization file}) to point to its full file name. @cindex Antivirus programs, and Shell Mode Some people have trouble with Shell Mode on MS-Windows because of @@ -3192,18 +3205,18 @@ if ("$term" == emacs) set term=dumb @node Errors with init files @section Why does Emacs say @samp{Error in init file}? -@cindex Error in @file{.emacs} +@cindex Error in @file{.emacs.d/init.el} @cindex Error in init file @cindex Init file, errors in -@cindex @file{.emacs} file, errors in -@cindex Debugging @file{.emacs} file +@cindex @file{.emacs.d/init.el} file, errors in +@cindex Debugging init file -An error occurred while loading either your @file{.emacs} file or the +An error occurred while loading either your init file or the system-wide file @file{site-lisp/default.el}. Emacs pops the @file{*Messages*} buffer, and puts there some additional information about the error, to provide some hints for debugging. -For information on how to debug your @file{.emacs} file, see +For information on how to debug your init file, see @ref{Debugging a customization file}. It may be the case that you need to load some package first, or use a @@ -3489,8 +3502,8 @@ and any Emacs Info files that might be in @file{/usr/local/share/info/}. @cindex Apple computers, Emacs for @cindex Macintosh, Emacs for @cindex macOS, Emacs for -Beginning with version 22.1, Emacs supports macOS natively. -See the file @file{nextstep/INSTALL} in the distribution. +Emacs supports macOS natively. See the file @file{nextstep/INSTALL} +in the distribution. @cindex FAQ for Emacs on MS-Windows @cindex Emacs for MS-Windows @@ -3499,8 +3512,8 @@ There is a separate FAQ for Emacs on MS-Windows, @pxref{Top,,,efaq-w32,FAQ for Emacs on MS Windows}. @cindex GNUstep, Emacs for -Beginning with version 23.1, Emacs supports GNUstep natively. -See the file @file{nextstep/INSTALL} in the distribution. +Emacs supports GNUstep natively. See the file @file{nextstep/INSTALL} +in the distribution. @cindex MS-DOS, Emacs for @cindex DOS, Emacs for @@ -3716,9 +3729,10 @@ information is available from @cindex Keys, binding to commands @cindex Commands, binding keys to -Keys can be bound to commands either interactively or in your -@file{.emacs} file. To interactively bind keys for all modes, type -@kbd{M-x global-set-key @key{RET} @var{key} @var{cmd} @key{RET}}. +Keys can be bound to commands either interactively or in your init +file (@pxref{Setting up a customization file}). To interactively bind +keys for all modes, type @kbd{M-x global-set-key @key{RET} @var{key} +@var{cmd} @key{RET}}. To bind a key just in the current major mode, type @kbd{M-x local-set-key @key{RET} @var{key} @var{cmd} @key{RET}}. @@ -3729,7 +3743,7 @@ To make the process of binding keys interactively easier, use the following ``trick'': First bind the key interactively, then immediately type @kbd{C-x @key{ESC} @key{ESC} C-a C-k C-g}. Now, the command needed to bind the key is in the kill ring, and can be yanked into your -@file{.emacs} file. If the key binding is global, no changes to the +init file. If the key binding is global, no changes to the command are required. For example, @lisp @@ -3737,9 +3751,9 @@ command are required. For example, @end lisp @noindent -can be placed directly into the @file{.emacs} file. If the key binding is -local, the command is used in conjunction with the @samp{add-hook} function. -For example, in TeX mode, a local binding might be +can be placed directly into your init file. If the key binding is +local, the command is used in conjunction with the @samp{add-hook} +function. For example, in TeX mode, a local binding might be @lisp (add-hook 'tex-mode-hook @@ -3797,14 +3811,15 @@ of these forms before attempting to bind the key sequence: @end lisp @node Terminal setup code works after Emacs has begun -@section Why doesn't this [terminal or window-system setup] code work in my @file{.emacs} file, but it works just fine after Emacs starts up? -@cindex Terminal setup code in @file{.emacs} +@section Why doesn't this [terminal or window-system setup] code work in my init file, but it works just fine after Emacs starts up? +@cindex Terminal setup code in init file -During startup, Emacs initializes itself according to a given code/file -order. If some of the code executed in your @file{.emacs} file needs to -be postponed until the initial terminal or window-system setup code has -been executed but is not, then you will experience this problem (this -code/file execution order is not enforced after startup). +During startup, Emacs initializes itself according to a given +code/file order. If some of the code executed in your init file +(@pxref{Setting up a customization file}) needs to be postponed until +the initial terminal or window-system setup code has been executed but +is not, then you will experience this problem (this code/file +execution order is not enforced after startup). To postpone the execution of Emacs Lisp code until after terminal or window-system setup, treat the code as a @dfn{lambda list} and add it to @@ -4225,8 +4240,7 @@ Emacs Manual}. For more sophisticated methods, @cindex bidirectional scripts Emacs supports display and editing of bidirectional scripts, such as -Arabic, Farsi, and Hebrew, since version 24.1. -@xref{New in Emacs 24, bidirectional display}. +Arabic, Farsi, and Hebrew. @node How to add fonts @@ -4254,7 +4268,8 @@ arrange for these two commands to run whenever you log in, e.g., by adding them to your window-system startup file, such as @file{~/.xsessionrc} or @file{~/.gnomerc}. -Now, add the following line to your @file{~/.emacs} init file: +Now, add the following line to your init file (@pxref{Setting up a +customization file}): @lisp (add-to-list 'bdf-directory-list "/usr/share/emacs/fonts/bdf") @@ -4264,15 +4279,15 @@ Now, add the following line to your @file{~/.emacs} init file: (Again, modify the file name if you installed the fonts elsewhere.) Finally, if you wish to use the installed fonts with @code{ps-print}, -add the following line to your @file{~/.emacs}: +add the following line to your init file: @lisp (setq ps-multibyte-buffer 'bdf-font-except-latin) @end lisp -You can now use the Emacs font menu to select the @samp{bdf: 16-dot medium} -fontset, or you can select it by setting the default font in your -@file{~/.emacs}: +You can now use the Emacs font menu to select the @samp{bdf: 16-dot +medium} fontset, or you can select it by setting the default font in +your init file: @lisp (set-frame-font "fontset-bdf") @@ -4334,9 +4349,9 @@ yourself by putting @end lisp @noindent -in your @file{.emacs} file. You can automatically include an @samp{FCC} -field by putting something like the following in your @file{.emacs} -file: +in your init file (@pxref{Setting up a customization file}). You can +automatically include an @samp{FCC} field by putting something like +the following in your init file: @lisp (setq mail-archive-file-name (expand-file-name "~/outgoing")) @@ -4368,8 +4383,7 @@ To expand them before this, use @kbd{M-x expand-mail-aliases}. Emacs normally only reads the @file{.mailrc} file once per session, when you start to compose your first mail message. If you edit the file after this, you can use @kbd{M-x build-mail-aliases} to make Emacs -reread it. Prior to Emacs 24.1, this is not an interactive command, so -you must instead type @kbd{M-: (build-mail-aliases) @key{RET}}. +reread it. @item If you like, you can expand mail aliases as abbrevs, as soon as you @@ -4467,7 +4481,7 @@ gnus @end example It is probably unwise to automatically start your mail or news reader -from your @file{.emacs} file. This would cause problems if you needed to run +from your init file. This would cause problems if you needed to run two copies of Emacs at the same time. Also, this would make it difficult for you to start Emacs quickly when you needed to. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index acc70a260f3..738ff94b9fc 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -9346,7 +9346,7 @@ Use @uref{http://emacs-w3m.namazu.org/, emacs-w3m}. Use @uref{http://w3m.sourceforge.net/, w3m}. @item links -Use @uref{https://almende.github.io/chap-links-library/, CHAP Links}. +Use @uref{http://links.twibright.com/, Links}. @item lynx Use @uref{https://lynx.browser.org/, Lynx}. diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi index fadc6a5cbe3..dabe2e36ff4 100644 --- a/doc/misc/htmlfontify.texi +++ b/doc/misc/htmlfontify.texi @@ -33,7 +33,7 @@ modify this GNU manual.'' @titlepage @title Htmlfontify User Manual @sp 4 -@subtitle Htmlfontify version 0.20 +@subtitle Htmlfontify version 0.21 @sp 1 @subtitle Jun 2002 @sp 5 diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index ddd9595fc89..1b4bf88a0cc 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -4,9 +4,9 @@ #+language: en #+options: ':t toc:nil author:t email:t num:t #+startup: content -#+macro: stable-version 2.5.0 -#+macro: release-date 2022-08-03 -#+macro: development-version 2.6.0-dev +#+macro: stable-version 2.6.0 +#+macro: release-date 2022-08-19 +#+macro: development-version 2.7.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -361,7 +361,7 @@ package configurations in their setup. We use this as an example: :config ;; Load the theme of your choice: (load-theme 'modus-operandi) ;; OR (load-theme 'modus-vivendi) - :bind ("<f5>" . modus-themes-toggle) + :bind ("<f5>" . modus-themes-toggle)) @@ -619,7 +619,7 @@ By default, customizing a theme-related user option through the Custom interfaces or with {{{kbd(M-x customize-set-variable)}}} will not reload the currently active Modus theme. -Enable this behaviour by setting this variable to ~nil~. +Enable this behavior by setting this variable to ~nil~. Regardless of this option, the active theme must be reloaded for changes to user options to take effect ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). @@ -2171,7 +2171,7 @@ things with precision ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization This section is of interest only to users who are prepared to maintain their own local tweaks and who are willing to deal with any possible incompatibilities between versioned releases of the themes. As such, -they are labelled as "do-it-yourself" or "DIY". +they are labeled as "do-it-yourself" or "DIY". ** More accurate colors in terminal emulators :PROPERTIES: @@ -2614,7 +2614,7 @@ this example: Whenever we enter a ~diff-mode~ buffer, we now get a magenta-colored region. -Perhaps you may wish to generalise those findings in to a set of +Perhaps you may wish to generalize those findings in to a set of functions that also accept an arbitrary face. We shall leave the experimentation up to you. @@ -2633,8 +2633,7 @@ contrast on an on-demand basis. One way to achieve this is to design a command that cycles through three distinct levels of intensity, though the following can be adapted to any -kind of cyclic behaviour, such as to switch between red, green, and -blue. +kind of cyclic behavior, such as to switch between red, green, and blue. In the following example, we employ the ~modus-themes-color~ function which reads a symbol that represents an entry in the active theme's @@ -4411,6 +4410,64 @@ Or include a ~let~ form, if needed: Normally, we do not touch user options, though this is an exception: otherwise the defaults are not always legible. +** Add support for solaire-mode +:PROPERTIES: +:CUSTOM_ID: h:439c9e46-52e2-46be-b1dc-85841dd99671 +:END: + +The =solaire-mode= package dims the background of what it considers +ancillary "UI" buffers, such as the minibuffer and Dired buffers. The +Modus themes used to support Solaire on the premise that the user was +(i) opting in to it, (ii) understood why certain buffers were more gray, +and (iii) knew what other adjustments had to be made to prevent broken +visuals (e.g. the default style of the ~modus-themes-completions~ uses a +subtle gray background for the selection, which with Solaire becomes +practically invisible). + +However, the assumption that users opt in to this feature does not +always hold true. There are cases where it is enabled by defaultsuch as +in the popular Doom Emacs configuration. Thus, the unsuspecting user +who loads ~modus-operandi~ or ~modus-vivendi~ without the requisite +customizations is getting a sub-par experience; an experience that we +did not intend and cannot genuinely fix. + +Because the Modus themes are meant to work everywhere, we cannot make an +exception for Doom Emacs and/or Solaire users. Furthermore, we shall +not introduce hacks, such as by adding a check in all relevant faces to +be adjusted based on Solaire or whatever other package. Hacks of this +sort are unsustainable and penalize the entire userbase. Besides, the +themes are built into Emacs and we must keep their standard high. + +The fundamental constraint with Solaire is that Emacs does not have a +real distinction between "content" and "UI" buffers. For themes to work +with Solaire, they need to be designed around that package. Such is an +arrangement that compromises on our accessibility standards and/or +hinders our efforts to provide the best possible experience while using +the Modus themes. + +As such, =solaire-mode= is not---and will not be---supported by the +Modus themes (or any other of my themes, for that matter). Users who +want it must style the faces manually. Below is some sample code, based +on what we cover at length elsewhere in this manual: + +[[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]. + +[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. + +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces () + (modus-themes-with-colors + (custom-set-faces + `(solaire-default-face ((,class :inherit default :background ,bg-alt :foreground ,fg-dim))) + `(solaire-line-number-face ((,class :inherit solaire-default-face :foreground ,fg-unfocused))) + `(solaire-hl-line-face ((,class :background ,bg-active))) + `(solaire-org-hide-face ((,class :background ,bg-alt :foreground ,bg-alt)))))) + +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) +#+end_src + +As always, re-load the theme for changes to take effect. + * Face coverage :properties: :custom_id: h:a9c8f29d-7f72-4b54-b74b-ddefe15d6a19 @@ -4679,7 +4736,6 @@ have lots of extensions, so the "full support" may not be 100% true… + smart-mode-line + smartparens + smerge -+ solaire + spaceline + speedbar + stripes @@ -4831,7 +4887,7 @@ The =git-gutter= and =git-gutter-fr= packages default to drawing bitmaps for the indicators they display (e.g. bitmap of a plus sign for added lines). In Doom Emacs, these bitmaps are replaced with contiguous lines which may look nicer, but require a change to the foreground of the -relevant faces to yield the desired colour combinations. +relevant faces to yield the desired color combinations. Since this is Doom-specific, we urge users to apply changes in their local setup. Below is some sample code, based on what we cover at @@ -4853,6 +4909,8 @@ length elsewhere in this manual: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src +As always, re-load the theme for changes to take effect. + If the above does not work, try this instead: #+begin_src emacs-lisp @@ -4888,6 +4946,8 @@ This seems to make all comments use the appropriate face: (add-hook 'php-mode-hook #'my-multine-comments) #+end_src +As always, re-load the theme for changes to take effect. + ** Note on underlines in compilation buffers :properties: :custom_id: h:420f5a33-c7a9-4112-9b04-eaf2cbad96bd @@ -5127,6 +5187,8 @@ implementation: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-highlight-parentheses) #+end_src +As always, re-load the theme for changes to take effect. + ** Note on mmm-mode.el background colors :properties: :custom_id: h:99cf0d6c-e478-4e26-9932-3bf3427d13f6 @@ -6014,9 +6076,10 @@ The Modus themes are a collective effort. Every bit of work matters. Carlo Zancanaro, Christian Tietze, Daniel Mendler, Eli Zaretskii, Fritz Grabo, Illia Ostapyshyn, Kévin Le Gouguec, Kostadin Ninev, Madhavan Krishnan, Manuel Giraud, Markus Beppler, Matthew Stevenson, - Mauro Aranda, Nicolas De Jaeghere, Philip Kaludercic, Pierre - Téchoueyres, Rudolf Adamkovič, Stephen Gildea, Shreyas Ragavan, Stefan - Kangas, Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen Xie. + Mauro Aranda, Nicolas De Jaeghere, Paul David, Philip Kaludercic, + Pierre Téchoueyres, Rudolf Adamkovič, Stephen Gildea, Shreyas Ragavan, + Stefan Kangas, Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen + Xie. + Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers, Adrian Manea, Alex Griffin, Alex Koen, Alex Peitsinis, Alexey Shmalko, diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 67602b90537..f86af0db3e5 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2022-04-09.08} +\def\texinfoversion{2022-08-20.19} % % Copyright 1985, 1986, 1988, 1990-2022 Free Software Foundation, Inc. % @@ -725,32 +725,22 @@ where each line of input produces a line of output.} \dimen2 = \ht\strutbox \advance\dimen2 by \dp\strutbox \ifdim\dimen0 > \dimen2 + % This is similar to the 'needspace' module in LaTeX. + % The first penalty allows a break if the end of the page is + % not too far away. Following penalties and skips are discarded. + % Otherwise, require at least \dimen0 of vertical space. % - % Do a \strut just to make the height of this box be normal, so the - % normal leading is inserted relative to the preceding line. - % And a page break here is fine. - \vtop to #1\mil{\strut\vfil}% - % - % TeX does not even consider page breaks if a penalty added to the - % main vertical list is 10000 or more. But in order to see if the - % empty box we just added fits on the page, we must make it consider - % page breaks. On the other hand, we don't want to actually break the - % page after the empty box. So we use a penalty of 9999. - % - % There is an extremely small chance that TeX will actually break the - % page at this \penalty, if there are no other feasible breakpoints in - % sight. (If the user is using lots of big @group commands, which - % almost-but-not-quite fill up a page, TeX will have a hard time doing - % good page breaking, for example.) However, I could not construct an - % example where a page broke at this \penalty; if it happens in a real - % document, then we can reconsider our strategy. + % (We used to use a \vtop to reserve space, but this had spacing issues + % when followed by a section heading, as it was not a "discardable item". + % This also has the benefit of providing glue before the page break if + % there isn't enough space.) + \vskip0pt plus \dimen0 + \penalty-100 + \vskip0pt plus -\dimen0 + \vskip \dimen0 \penalty9999 - % - % Back up by the size of the box, whether we did a page break or not. - \kern -#1\mil - % - % Do not allow a page break right after this kern. - \nobreak + \vskip -\dimen0 + \penalty0\relax % this hides the above glue from \safewhatsit and \dobreak \fi } @@ -1002,7 +992,7 @@ where each line of input produces a line of output.} \global\everypar = {}% } -% leave vertical mode without canceling any first paragraph indent +% leave vertical mode without cancelling any first paragraph indent \gdef\imageindent{% \toks0=\everypar \everypar={}% @@ -2558,7 +2548,7 @@ end \def\it{\fam=\itfam \setfontstyle{it}} \def\sl{\fam=\slfam \setfontstyle{sl}} \def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf} -\def\tt{\fam=\ttfam \setfontstyle{tt}}\def\ttstylename{tt} +\def\tt{\fam=\ttfam \setfontstyle{tt}} % Texinfo sort of supports the sans serif font style, which plain TeX does not. % So we set up a \sf. @@ -2691,6 +2681,14 @@ end % \def\ifmonospace{\ifdim\fontdimen3\font=0pt } +% Check if internal flag is clear, i.e. has not been @set. +\def\ifflagclear#1#2#3{% + \expandafter\ifx\csname SET#1\endcsname\relax + #2\else#3\fi +} + + + { \catcode`\'=\active \catcode`\`=\active @@ -2707,14 +2705,14 @@ end % \def\codequoteright{% \ifmonospace - \expandafter\ifx\csname SETtxicodequoteundirected\endcsname\relax - \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax + \ifflagclear{txicodequoteundirected}{% + \ifflagclear{codequoteundirected}{% '% - \else \char'15 \fi - \else \char'15 \fi - \else - '% - \fi + }{\char'15 }% + }{\char'15 }% + \else + '% + \fi } % % and a similar option for the left quote char vs. a grave accent. @@ -2723,16 +2721,16 @@ end % \def\codequoteleft{% \ifmonospace - \expandafter\ifx\csname SETtxicodequotebacktick\endcsname\relax - \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax + \ifflagclear{txicodequotebacktick}{% + \ifflagclear{codequotebacktick}{% % [Knuth] pp. 380,381,391 % \relax disables Spanish ligatures ?` and !` of \tt font. \relax`% - \else \char'22 \fi - \else \char'22 \fi - \else - \relax`% - \fi + }{\char'22 }% + }{\char'22 }% + \else + \relax`% + \fi } % Commands to set the quote options. @@ -2779,15 +2777,16 @@ end \def\dosmartslant#1#2{% \ifusingtt {{\ttsl #2}\let\next=\relax}% - {\def\next{{#1#2}\futurelet\next\smartitaliccorrection}}% + {\def\next{{#1#2}\smartitaliccorrection}}% \next } \def\smartslanted{\dosmartslant\sl} \def\smartitalic{\dosmartslant\it} -% Output an italic correction unless \next (presumed to be the following -% character) is such as not to need one. -\def\smartitaliccorrection{% +% Output an italic correction unless the following character is such as +% not to need one. +\def\smartitaliccorrection{\futurelet\next\smartitaliccorrectionx} +\def\smartitaliccorrectionx{% \ifx\next,% \else\ifx\next-% \else\ifx\next.% @@ -2798,18 +2797,18 @@ end \aftersmartic } -% Unconditional use \ttsl, and no ic. @var is set to this for defuns. -\def\ttslanted#1{{\ttsl #1}} - -% @cite is like \smartslanted except unconditionally use \sl. We never want -% ttsl for book titles, do we? -\def\cite#1{{\sl #1}\futurelet\next\smartitaliccorrection} +% @cite unconditionally uses \sl with \smartitaliccorrection. +\def\cite#1{{\sl #1}\smartitaliccorrection} +% @var unconditionally uses \sl. This gives consistency for +% parameter names whether they are in @def, @table @code or a +% regular paragraph. +% The \null is to reset \spacefactor. \def\aftersmartic{} \def\var#1{% \let\saveaftersmartic = \aftersmartic \def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}% - \smartslanted{#1}% + {\sl #1}\smartitaliccorrection } \let\i=\smartitalic @@ -2817,8 +2816,14 @@ end \let\dfn=\smartslanted \let\emph=\smartitalic -% Explicit font changes: @r, @sc, undocumented @ii. -\def\r#1{{\rm #1}} % roman font +% @r for roman font, used for code comment +\def\r#1{{% + \usenormaldash % get --, --- ligatures even if in @code + \defcharsdefault % in case on def line + \rm #1}} +{\catcode`-=\active \gdef\usenormaldash{\let-\normaldash}} + +% @sc, undocumented @ii. \def\sc#1{{\smallcaps#1}} % smallcaps font \def\ii#1{{\it #1}} % italic font @@ -2856,7 +2861,7 @@ end % @t, explicit typewriter. \def\t#1{% - {\tt \plainfrenchspacing #1}% + {\tt \defcharsdefault \plainfrenchspacing #1}% \null } @@ -4432,7 +4437,7 @@ $$% \message{conditionals,} -% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotplaintext, +% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotlatex, @ifnotplaintext, % @ifnotxml always succeed. They currently do nothing; we don't % attempt to check whether the conditionals are properly nested. But we % have to remember that they are conditionals, so that @end doesn't @@ -4446,6 +4451,7 @@ $$% \makecond{ifnotdocbook} \makecond{ifnothtml} \makecond{ifnotinfo} +\makecond{ifnotlatex} \makecond{ifnotplaintext} \makecond{ifnotxml} @@ -4458,10 +4464,12 @@ $$% \def\ifdocbook{\doignore{ifdocbook}} \def\ifhtml{\doignore{ifhtml}} \def\ifinfo{\doignore{ifinfo}} +\def\iflatex{\doignore{iflatex}} \def\ifnottex{\doignore{ifnottex}} \def\ifplaintext{\doignore{ifplaintext}} \def\ifxml{\doignore{ifxml}} \def\ignore{\doignore{ignore}} +\def\latex{\doignore{latex}} \def\menu{\doignore{menu}} \def\xml{\doignore{xml}} @@ -4985,25 +4993,24 @@ $$% \catcode`\-=13 \catcode`\`=13 \gdef\indexnonalnumdisappear{% - \expandafter\ifx\csname SETtxiindexlquoteignore\endcsname\relax\else + \ifflagclear{txiindexlquoteignore}{}{% % @set txiindexlquoteignore makes us ignore left quotes in the sort term. % (Introduced for FSFS 2nd ed.) \let`=\empty - \fi + }% % - \expandafter\ifx\csname SETtxiindexbackslashignore\endcsname\relax\else + \ifflagclear{txiindexbackslashignore}{}{% \backslashdisappear - \fi - % - \expandafter\ifx\csname SETtxiindexhyphenignore\endcsname\relax\else + }% + \ifflagclear{txiindexhyphenignore}{}{% \def-{}% - \fi - \expandafter\ifx\csname SETtxiindexlessthanignore\endcsname\relax\else + }% + \ifflagclear{txiindexlessthanignore}{}{% \def<{}% - \fi - \expandafter\ifx\csname SETtxiindexatsignignore\endcsname\relax\else + }% + \ifflagclear{txiindexatsignignore}{}{% \def\@{}% - \fi + }% } \gdef\indexnonalnumreappear{% @@ -5295,9 +5302,7 @@ $$% % \atdummies % - \expandafter\ifx\csname SETtxiindexescapeisbackslash\endcsname\relax\else - \escapeisbackslash - \fi + \ifflagclear{txiindexescapeisbackslash}{}{\escapeisbackslash}% % % For texindex which always views { and } as separators. \def\{{\lbracechar{}}% @@ -5481,9 +5486,9 @@ $$% % old index files using \ as the escape character. Reading this would % at best lead to typesetting garbage, at worst a TeX syntax error. \def\printindexzz#1#2\finish{% - \expandafter\ifx\csname SETtxiindexescapeisbackslash\endcsname\relax + \ifflagclear{txiindexescapeisbackslash}{% \uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1 - \expandafter\ifx\csname SETtxiskipindexfileswithbackslash\endcsname\relax + \ifflagclear{txiskipindexfileswithbackslash}{% \errmessage{% ERROR: A sorted index file in an obsolete format was skipped. To fix this problem, please upgrade your version of 'texi2dvi' @@ -5499,15 +5504,15 @@ this, Texinfo will try to use index files in the old format. If you continue to have problems, deleting the index files and starting again might help (with 'rm \jobname.?? \jobname.??s')% }% - \else + }{% (Skipped sorted index file in obsolete format) - \fi + }% \else \begindoublecolumns \input \jobname.\indexname s \enddoublecolumns \fi - \else + }{% \begindoublecolumns \catcode`\\=0\relax % @@ -5517,7 +5522,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \catcode`\@=0\relax \input \jobname.\indexname s \enddoublecolumns - \fi + }% } % These macros are used by the sorted index file itself. @@ -7277,22 +7282,6 @@ might help (with 'rm \jobname.?? \jobname.??s')% } \let\Eraggedright\par -\envdef\raggedleft{% - \parindent=0pt \leftskip0pt plus2em - \spaceskip.3333em \xspaceskip.5em \parfillskip=0pt - \hbadness=10000 % Last line will usually be underfull, so turn off - % badness reporting. -} -\let\Eraggedleft\par - -\envdef\raggedcenter{% - \parindent=0pt \rightskip0pt plus1em \leftskip0pt plus1em - \spaceskip.3333em \xspaceskip.5em \parfillskip=0pt - \hbadness=10000 % Last line will usually be underfull, so turn off - % badness reporting. -} -\let\Eraggedcenter\par - % @quotation does normal linebreaking (hence we can't use \nonfillstart) % and narrows the margins. We keep \parskip nonzero in general, since @@ -7515,9 +7504,11 @@ might help (with 'rm \jobname.?? \jobname.??s')% % file; b) letting users define the frontmatter in as flexible order as % possible is desirable. % -\def\copying{\checkenv{}\begingroup\scanargctxt\docopying} -\def\docopying#1@end copying{\endgroup\def\copyingtext{#1}} -% +\def\copying{\checkenv{}\begingroup\macrobodyctxt\docopying} +{\catcode`\ =\other +\gdef\docopying#1@end copying{\endgroup\def\copyingtext{#1}} +} + \def\insertcopying{% \begingroup \parindent = 0pt % paragraph indentation looks wrong on title page @@ -7599,21 +7590,15 @@ might help (with 'rm \jobname.?? \jobname.??s')% \def\Edefun{\endgraf\medbreak} -% \makedefun{deffn} creates \deffn, \deffnx and \Edeffn; -% the only thing remaining is to define \deffnheader. +% \makedefun{deffoo}{ (definition of \deffooheader) } % +% Define \deffoo, \deffoox \Edeffoo and \deffooheader. \def\makedefun#1{% \expandafter\let\csname E#1\endcsname = \Edefun \edef\temp{\noexpand\domakedefun \makecsname{#1}\makecsname{#1x}\makecsname{#1header}}% \temp } - -% \domakedefun \deffn \deffnx \deffnheader { (defn. of \deffnheader) } -% -% Define \deffn and \deffnx, without parameters. -% \deffnheader has to be defined explicitly. -% \def\domakedefun#1#2#3{% \envdef#1{% \startdefun @@ -7646,74 +7631,51 @@ might help (with 'rm \jobname.?? \jobname.??s')% \fi\fi } -% \dosubind {index}{topic}{subtopic} -% -% If SUBTOPIC is present, precede it with a space, and call \doind. -% (At some time during the 20th century, this made a two-level entry in an -% index such as the operation index. Nobody seemed to notice the change in -% behaviour though.) -\def\dosubind#1#2#3{% - \def\thirdarg{#3}% - \ifx\thirdarg\empty - \doind{#1}{#2}% - \else - \doind{#1}{#2\space#3}% - \fi -} - % Untyped functions: % @deffn category name args -\makedefun{deffn}{\deffngeneral{}} - -% @deffn category class name args -\makedefun{defop}#1 {\defopon{#1\ \putwordon}} - -% \defopon {category on}class name args -\def\defopon#1#2 {\deffngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} } +\makedefun{deffn}#1 #2 #3\endheader{% + \doind{fn}{\code{#2}}% + \defname{#1}{}{#2}\magicamp\defunargs{#3\unskip}% +} -% \deffngeneral {subind}category name args -% -\def\deffngeneral#1#2 #3 #4\endheader{% - \dosubind{fn}{\code{#3}}{#1}% - \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}% +% @defop category class name args +\makedefun{defop}#1 {\defopheaderx{#1\ \putwordon}} +\def\defopheaderx#1#2 #3 #4\endheader{% + \doind{fn}{\code{#3}\space\putwordon\ \code{#2}}% + \defname{#1\ \code{#2}}{}{#3}\magicamp\defunargs{#4\unskip}% } % Typed functions: % @deftypefn category type name args -\makedefun{deftypefn}{\deftypefngeneral{}} +\makedefun{deftypefn}#1 #2 #3 #4\endheader{% + \doind{fn}{\code{#3}}% + \doingtypefntrue + \defname{#1}{#2}{#3}\defunargs{#4\unskip}% +} % @deftypeop category class type name args -\makedefun{deftypeop}#1 {\deftypeopon{#1\ \putwordon}} - -% \deftypeopon {category on}class type name args -\def\deftypeopon#1#2 {\deftypefngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} } - -% \deftypefngeneral {subind}category type name args -% -\def\deftypefngeneral#1#2 #3 #4 #5\endheader{% - \dosubind{fn}{\code{#4}}{#1}% +\makedefun{deftypeop}#1 {\deftypeopheaderx{#1\ \putwordon}} +\def\deftypeopheaderx#1#2 #3 #4 #5\endheader{% + \doind{fn}{\code{#4}\space\putwordon\ \code{#1\ \code{#2}}}% \doingtypefntrue - \defname{#2}{#3}{#4}\defunargs{#5\unskip}% + \defname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}% } % Typed variables: % @deftypevr category type var args -\makedefun{deftypevr}{\deftypecvgeneral{}} +\makedefun{deftypevr}#1 #2 #3 #4\endheader{% + \doind{vr}{\code{#3}}% + \defname{#1}{#2}{#3}\defunargs{#4\unskip}% +} % @deftypecv category class type var args -\makedefun{deftypecv}#1 {\deftypecvof{#1\ \putwordof}} - -% \deftypecvof {category of}class type var args -\def\deftypecvof#1#2 {\deftypecvgeneral{\putwordof\ \code{#2}}{#1\ \code{#2}} } - -% \deftypecvgeneral {subind}category type var args -% -\def\deftypecvgeneral#1#2 #3 #4 #5\endheader{% - \dosubind{vr}{\code{#4}}{#1}% - \defname{#2}{#3}{#4}\defunargs{#5\unskip}% +\makedefun{deftypecv}#1 {\deftypecvheaderx{#1\ \putwordof}} +\def\deftypecvheaderx#1#2 #3 #4 #5\endheader{% + \doind{vr}{\code{#4}\space\putwordof\ \code{#2}}% + \defname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}% } % Untyped variables: @@ -7722,10 +7684,8 @@ might help (with 'rm \jobname.?? \jobname.??s')% \makedefun{defvr}#1 {\deftypevrheader{#1} {} } % @defcv category class var args -\makedefun{defcv}#1 {\defcvof{#1\ \putwordof}} - -% \defcvof {category of}class var args -\def\defcvof#1#2 {\deftypecvof{#1}#2 {} } +\makedefun{defcv}#1 {\defcvheaderx{#1\ \putwordof}} +\def\defcvheaderx#1#2 {\deftypecvheaderx{#1}#2 {} } % Types: @@ -7743,10 +7703,10 @@ might help (with 'rm \jobname.?? \jobname.??s')% \makedefun{defvar}{\defvrheader{\putwordDefvar} } \makedefun{defopt}{\defvrheader{\putwordDefopt} } \makedefun{deftypevar}{\deftypevrheader{\putwordDefvar} } -\makedefun{defmethod}{\defopon\putwordMethodon} -\makedefun{deftypemethod}{\deftypeopon\putwordMethodon} -\makedefun{defivar}{\defcvof\putwordInstanceVariableof} -\makedefun{deftypeivar}{\deftypecvof\putwordInstanceVariableof} +\makedefun{defmethod}{\defopheaderx\putwordMethodon} +\makedefun{deftypemethod}{\deftypeopheaderx\putwordMethodon} +\makedefun{defivar}{\defcvheaderx\putwordInstanceVariableof} +\makedefun{deftypeivar}{\deftypecvheaderx\putwordInstanceVariableof} % \defname, which formats the name of the @def (not the args). % #1 is the category, such as "Function". @@ -7765,9 +7725,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \rettypeownlinefalse \ifdoingtypefn % doing a typed function specifically? % then check user option for putting return type on its own line: - \expandafter\ifx\csname SETtxideftypefnnl\endcsname\relax \else - \rettypeownlinetrue - \fi + \ifflagclear{txideftypefnnl}{}{\rettypeownlinetrue}% \fi % % How we'll format the category name. Putting it in brackets helps @@ -7832,30 +7790,18 @@ might help (with 'rm \jobname.?? \jobname.??s')% \fi % no return type #3% output function name }% - {\rm\enskip}% hskip 0.5 em of \rmfont + \ifflagclear{txidefnamenospace}{% + {\rm\enskip}% hskip 0.5 em of \rmfont + }{}% % \boldbrax % arguments will be output next, if any. } -% Print arguments in slanted roman (not ttsl), inconsistently with using -% tt for the name. This is because literal text is sometimes needed in -% the argument list (groff manual), and ttsl and tt are not very -% distinguishable. Prevent hyphenation at `-' chars. -% +% Print arguments. Use slanted for @def*, typewriter for @deftype*. \def\defunargs#1{% - % use sl by default (not ttsl), - % tt for the names. - \df \sl \hyphenchar\font=0 - % - % On the other hand, if an argument has two dashes (for instance), we - % want a way to get ttsl. We used to recommend @var for that, so - % leave the code in, but it's strange for @var to lead to typewriter. - % Nowadays we recommend @code, since the difference between a ttsl hyphen - % and a tt hyphen is pretty tiny. @code also disables ?` !`. - \def\var##1{{\setregularquotes\ttslanted{##1}}}% + \df \ifdoingtypefn \tt \else \sl \fi #1% - \sl\hyphenchar\font=45 } % We want ()&[] to print specially on the defun line. @@ -7874,9 +7820,12 @@ might help (with 'rm \jobname.?? \jobname.??s')% % so TeX would otherwise complain about undefined control sequence. { \activeparens - \global\let(=\lparen \global\let)=\rparen - \global\let[=\lbrack \global\let]=\rbrack - \global\let& = \& + \gdef\defcharsdefault{% + \let(=\lparen \let)=\rparen + \let[=\lbrack \let]=\rbrack + \let& = \&% + } + \globaldefs=1 \defcharsdefault \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} \gdef\magicamp{\let&=\amprm} @@ -8060,24 +8009,17 @@ might help (with 'rm \jobname.?? \jobname.??s')% \catcode`\_=\other \catcode`\|=\other \catcode`\~=\other - \passthroughcharstrue -} - -\def\scanargctxt{% used for copying and captions, not macros. - \scanctxt \catcode`\@=\other - \catcode`\\=\other \catcode`\^^M=\other + \catcode`\\=\active + \passthroughcharstrue } -\def\macrobodyctxt{% used for @macro definitions +\def\macrobodyctxt{% used for @macro definitions and @copying \scanctxt \catcode`\ =\other - \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other - \catcode`\^^M=\other - \usembodybackslash } % Used when scanning braced macro arguments. Note, however, that catcode @@ -8086,14 +8028,10 @@ might help (with 'rm \jobname.?? \jobname.??s')% \def\macroargctxt{% \scanctxt \catcode`\ =\active - \catcode`\@=\other - \catcode`\^^M=\other - \catcode`\\=\active } \def\macrolineargctxt{% used for whole-line arguments without braces \scanctxt - \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other } @@ -8137,7 +8075,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \global\expandafter\let\csname ismacro.\the\macname\endcsname=1% \addtomacrolist{\the\macname}% \fi - \begingroup \macrobodyctxt + \begingroup \macrobodyctxt \usembodybackslash \ifrecursive \expandafter\parsermacbody \else \expandafter\parsemacbody \fi} @@ -8941,7 +8879,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% % output the `[mynode]' via the macro below so it can be overridden. \xrefprintnodename\printedrefname % - \expandafter\ifx\csname SETtxiomitxrefpg\endcsname\relax + \ifflagclear{txiomitxrefpg}{% % But we always want a comma and a space: ,\space % @@ -8956,7 +8894,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \tokenafterxref ,% @NL \else\ifx\tie\tokenafterxref ,% @tie \fi\fi\fi\fi\fi\fi - \fi + }{}% \fi\fi \fi \endlink @@ -9604,7 +9542,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% % \def\caption{\docaption\thiscaption} \def\shortcaption{\docaption\thisshortcaption} -\def\docaption{\checkenv\float \bgroup\scanargctxt\defcaption} +\def\docaption{\checkenv\float \bgroup\scanctxt\defcaption} \def\defcaption#1#2{\egroup \def#1{#2}} % The parameter is the control sequence identifying the counter we are @@ -10324,9 +10262,9 @@ directory should work if nowhere else does.} % Given the value in \countUTFz as a Unicode code point, set \UTFviiiTmp % to the corresponding UTF-8 sequence. \gdef\parseXMLCharref{% - \ifnum\countUTFz < "A0\relax + \ifnum\countUTFz < "20\relax \errhelp = \EMsimple - \errmessage{Cannot define Unicode char value < 00A0}% + \errmessage{Cannot define Unicode char value < 0020}% \else\ifnum\countUTFz < "800\relax \parseUTFviiiA,% \parseUTFviiiB C\UTFviiiTwoOctetsName.,% @@ -10396,6 +10334,103 @@ directory should work if nowhere else does.} % least make most of the characters not bomb out. % \def\unicodechardefs{% + \DeclareUnicodeCharacter{0020}{ } % space + \DeclareUnicodeCharacter{0021}{\char"21 }% % space to terminate number + \DeclareUnicodeCharacter{0022}{\char"22 }% + \DeclareUnicodeCharacter{0023}{\char"23 }% + \DeclareUnicodeCharacter{0024}{\char"24 }% + \DeclareUnicodeCharacter{0025}{\char"25 }% + \DeclareUnicodeCharacter{0026}{\char"26 }% + \DeclareUnicodeCharacter{0027}{\char"27 }% + \DeclareUnicodeCharacter{0028}{\char"28 }% + \DeclareUnicodeCharacter{0029}{\char"29 }% + \DeclareUnicodeCharacter{002A}{\char"2A }% + \DeclareUnicodeCharacter{002B}{\char"2B }% + \DeclareUnicodeCharacter{002C}{\char"2C }% + \DeclareUnicodeCharacter{002D}{\char"2D }% + \DeclareUnicodeCharacter{002E}{\char"2E }% + \DeclareUnicodeCharacter{002F}{\char"2F }% + \DeclareUnicodeCharacter{0030}{0}% + \DeclareUnicodeCharacter{0031}{1}% + \DeclareUnicodeCharacter{0032}{2}% + \DeclareUnicodeCharacter{0033}{3}% + \DeclareUnicodeCharacter{0034}{4}% + \DeclareUnicodeCharacter{0035}{5}% + \DeclareUnicodeCharacter{0036}{6}% + \DeclareUnicodeCharacter{0037}{7}% + \DeclareUnicodeCharacter{0038}{8}% + \DeclareUnicodeCharacter{0039}{9}% + \DeclareUnicodeCharacter{003A}{\char"3A }% + \DeclareUnicodeCharacter{003B}{\char"3B }% + \DeclareUnicodeCharacter{003C}{\char"3C }% + \DeclareUnicodeCharacter{003D}{\char"3D }% + \DeclareUnicodeCharacter{003E}{\char"3E }% + \DeclareUnicodeCharacter{003F}{\char"3F }% + \DeclareUnicodeCharacter{0040}{\char"40 }% + \DeclareUnicodeCharacter{0041}{A}% + \DeclareUnicodeCharacter{0042}{B}% + \DeclareUnicodeCharacter{0043}{C}% + \DeclareUnicodeCharacter{0044}{D}% + \DeclareUnicodeCharacter{0045}{E}% + \DeclareUnicodeCharacter{0046}{F}% + \DeclareUnicodeCharacter{0047}{G}% + \DeclareUnicodeCharacter{0048}{H}% + \DeclareUnicodeCharacter{0049}{I}% + \DeclareUnicodeCharacter{004A}{J}% + \DeclareUnicodeCharacter{004B}{K}% + \DeclareUnicodeCharacter{004C}{L}% + \DeclareUnicodeCharacter{004D}{M}% + \DeclareUnicodeCharacter{004E}{N}% + \DeclareUnicodeCharacter{004F}{O}% + \DeclareUnicodeCharacter{0050}{P}% + \DeclareUnicodeCharacter{0051}{Q}% + \DeclareUnicodeCharacter{0052}{R}% + \DeclareUnicodeCharacter{0053}{S}% + \DeclareUnicodeCharacter{0054}{T}% + \DeclareUnicodeCharacter{0055}{U}% + \DeclareUnicodeCharacter{0056}{V}% + \DeclareUnicodeCharacter{0057}{W}% + \DeclareUnicodeCharacter{0058}{X}% + \DeclareUnicodeCharacter{0059}{Y}% + \DeclareUnicodeCharacter{005A}{Z}% + \DeclareUnicodeCharacter{005B}{\char"5B }% + \DeclareUnicodeCharacter{005C}{\char"5C }% + \DeclareUnicodeCharacter{005D}{\char"5D }% + \DeclareUnicodeCharacter{005E}{\char"5E }% + \DeclareUnicodeCharacter{005F}{\char"5F }% + \DeclareUnicodeCharacter{0060}{\char"60 }% + \DeclareUnicodeCharacter{0061}{a}% + \DeclareUnicodeCharacter{0062}{b}% + \DeclareUnicodeCharacter{0063}{c}% + \DeclareUnicodeCharacter{0064}{d}% + \DeclareUnicodeCharacter{0065}{e}% + \DeclareUnicodeCharacter{0066}{f}% + \DeclareUnicodeCharacter{0067}{g}% + \DeclareUnicodeCharacter{0068}{h}% + \DeclareUnicodeCharacter{0069}{i}% + \DeclareUnicodeCharacter{006A}{j}% + \DeclareUnicodeCharacter{006B}{k}% + \DeclareUnicodeCharacter{006C}{l}% + \DeclareUnicodeCharacter{006D}{m}% + \DeclareUnicodeCharacter{006E}{n}% + \DeclareUnicodeCharacter{006F}{o}% + \DeclareUnicodeCharacter{0070}{p}% + \DeclareUnicodeCharacter{0071}{q}% + \DeclareUnicodeCharacter{0072}{r}% + \DeclareUnicodeCharacter{0073}{s}% + \DeclareUnicodeCharacter{0074}{t}% + \DeclareUnicodeCharacter{0075}{u}% + \DeclareUnicodeCharacter{0076}{v}% + \DeclareUnicodeCharacter{0077}{w}% + \DeclareUnicodeCharacter{0078}{x}% + \DeclareUnicodeCharacter{0079}{y}% + \DeclareUnicodeCharacter{007A}{z}% + \DeclareUnicodeCharacter{007B}{\char"7B }% + \DeclareUnicodeCharacter{007C}{\char"7C }% + \DeclareUnicodeCharacter{007D}{\char"7D }% + \DeclareUnicodeCharacter{007E}{\char"7E }% + % \DeclareUnicodeCharacter{007F}{} % DEL + % \DeclareUnicodeCharacter{00A0}{\tie}% \DeclareUnicodeCharacter{00A1}{\exclamdown}% \DeclareUnicodeCharacter{00A2}{{\tcfont \char162}}% 0242=cent @@ -11080,24 +11115,26 @@ directory should work if nowhere else does.} % provide a definition macro to replace/pass-through a Unicode character % \def\DeclareUnicodeCharacterNative#1#2{% - \catcode"#1=\active - \def\dodeclareunicodecharacternative##1##2##3{% + \ifnum"#1>"7F % only make non-ASCII chars active + \catcode"#1=\active + \def\dodeclareunicodecharacternative##1##2##3{% + \begingroup + \uccode`\~="##2\relax + \uppercase{\gdef~}{% + \ifpassthroughchars + ##1% + \else + ##3% + \fi + } + \endgroup + } \begingroup - \uccode`\~="##2\relax - \uppercase{\gdef~}{% - \ifpassthroughchars - ##1% - \else - ##3% - \fi - } + \uccode`\.="#1\relax + \uppercase{\def\UTFNativeTmp{.}}% + \expandafter\dodeclareunicodecharacternative\UTFNativeTmp{#1}{#2}% \endgroup - } - \begingroup - \uccode`\.="#1\relax - \uppercase{\def\UTFNativeTmp{.}}% - \expandafter\dodeclareunicodecharacternative\UTFNativeTmp{#1}{#2}% - \endgroup + \fi } % Native Unicode handling (XeTeX and LuaTeX) character replacing definition. @@ -11276,7 +11313,7 @@ directory should work if nowhere else does.} \textleading = 12.5pt % \internalpagesizes{160mm}{120mm}% - {\voffset}{\hoffset}% + {\voffset}{-11.4mm}% {\bindingoffset}{8pt}% {210mm}{148mm}% % @@ -11358,6 +11395,7 @@ directory should work if nowhere else does.} \message{and turning on texinfo input format.} \def^^L{\par} % remove \outer, so ^L can appear in an @comment +\catcode`\^^K = 10 % treat vertical tab as whitespace % DEL is a comment character, in case @c does not suffice. \catcode`\^^? = 14 diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 96ffb5c8809..0e55b6c1d2a 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4826,9 +4826,12 @@ authentication delays. During these operations, @value{tramp}'s responsiveness slows down. Some suggestions within the scope of @value{tramp}'s settings include: +@itemize @minus +@item Use an external method, such as @option{scp}, which are faster than -internal methods. +internal methods for large files. +@item Keep the file @code{tramp-persistency-file-name}, which is where @value{tramp} caches remote information about hosts and files. Caching is enabled by default. Don't disable it. @@ -4839,6 +4842,7 @@ files are not independently updated outside @value{tramp}'s control. That cache cleanup will be necessary if the remote directories or files are updated independent of @value{tramp}. +@item Disable version control to avoid delays: @lisp @@ -4858,9 +4862,17 @@ about, for example: (setq vc-handled-backends '(SVN Git)) @end lisp +@item +@vindex remote-file-name-inhibit-locks +Disable file locks. Set @code{remote-file-name-inhibit-locks} to +@code{t} if you know that different Emacs sessions are not modifying +the same remote file. + +@item Disable excessive traces. Set @code{tramp-verbose} to 3 or lower, default being 3. Increase trace levels temporarily when hunting for bugs. +@end itemize @item diff --git a/etc/DEBUG b/etc/DEBUG index df289310f9f..f57e6f197bf 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -661,10 +661,10 @@ Setting a breakpoint in the function 'x_error_quitter' and looking at the backtrace when Emacs stops inside that function will show what code causes the X protocol errors. -Note that the -xrm option may have no effect when you make an Emacs -process invoked with the -nw option a server and want to trace X -protocol errors from subsequent invocations of emacsclient in a GUI -frame. In that case calling the initial Emacs via +Note that the -xrm option may have no effect when you start a server +in an Emacs session invoked with the -nw command-line option, and want +to trace X protocol errors from GUI frames created by subsequent +invocations of emacsclient. In that case starting Emacs via emacs -nw --eval '(setq x-command-line-resources "emacs.synchronous: true")' @@ -39,16 +39,12 @@ C++ compiler to be present on your system. If Emacs is not built with the option '--with-be-app', the resulting Emacs will only run in text-mode terminals. -+++ -** Cairo drawing support has been enabled for Haiku builds. To enable Cairo support, ensure that the Cairo and FreeType development files are present on your system, and configure Emacs with '--with-be-cairo'. ---- -** Double buffering is now enabled on the Haiku operating system. Unlike X, there is no compile-time option to enable or disable -double-buffering. If you wish to disable double-buffering, change the +double-buffering; it is always enabled. To disable it, change the frame parameter 'inhibit-double-buffering' instead. --- @@ -166,6 +162,14 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 ++++ +*** Explicitly-set read-only state is preserved when reverting a buffer. +If you use the 'C-x C-q' command to change the read-only state of the +buffer and then revert it, Emacs would previously use the file +permission bits to determine whether the buffer should be read-only +after reverting the buffer. Emacs now remembers the decision made in +'C-x C-q'. + --- *** The Gtk selection face is no longer used for the region. The combination of a Gtk-controlled background and a foreground color @@ -1159,6 +1163,12 @@ change the input method's translation rules, customize the user option ** Dired ++++ +*** 'dired-guess-shell-command' moved from dired-x to dired. +This means that 'dired-do-shell-command' will now provide smarter +defaults without first having to require 'dired-x'. See the node +"(emacs) Shell Command Guessing" in the Emacs manual for more details. + --- *** 'dired-clean-up-buffers-too' moved from dired-x to dired. This means that Dired now offers to kill buffers visiting files and @@ -1515,11 +1525,26 @@ command accepts the Unicode name of an Emoji (for example, "smiling face" or "heart with arrow"), like 'C-x 8 e e', with minibuffer completion, and adds the Emoji into the search string. +** Glyphless characters + +++ -** New minor mode 'glyphless-display-mode'. +*** New minor mode 'glyphless-display-mode'. This allows an easy way to toggle seeing all glyphless characters in the current buffer. ++++ +*** The extra slot of 'glyphless-char-display' can now have cons values. +The extra slot of the 'glyphless-char-display' char-table can now have +values that are cons cells, specifying separate values for text-mode +and GUI terminals. + +--- +*** "Replacement character" feature for undisplayable characters on TTYs. +The 'acronym' method of displaying glyphless characters on text-mode +frames treats single-character acronyms specially: they are displayed +without the surrounding [..] "box", thus in effect treating such +"acronyms" as replacement characters. + ** Registers +++ @@ -1555,6 +1580,12 @@ info node. This command only works for the Emacs and Emacs Lisp manuals. This command marks files based on a regexp. If given a prefix argument, unmark instead. +*** 'C-x v v' on a diff buffer commits it as a patch. +You can create a diff buffer by e.g. 'C-x v D' ('vc-root-diff'), +then remove unnecessary hunks, and commit only part of your changes +by typing 'C-x v v' in that diff buffer. Currently this works only +with Git. + --- *** 'C-x v v' on an unregistered file will now use the most specific backend. Previously, if you had an SVN-covered "~/" directory, and a Git-covered @@ -1857,6 +1888,11 @@ this message for SVG and XPM. *** New commands: 'image-flip-horizontally' and 'image-flip-vertically'. These commands horizontally and vertically flip the image under point. ++++ +*** New command 'image-transform-set-percent'. +It allows setting the image size to a percentage of its original size, +and is bound to "s p" in Image mode. + ** Images +++ @@ -1995,7 +2031,10 @@ the buffer will take you to that directory. *** Search and replace in Dired/Wdired supports more regexps. For example, the regexp ".*" will match only characters that are part of the file name. Also "^.*$" can be used to match at the beginning -of the file name and at the end of the file name. +of the file name and at the end of the file name. This is used only +when searching on file names. In Wdired this can be used when the new +user option 'wdired-search-replace-filenames' is non-nil (which is the +default). ** Bookmarks @@ -2533,7 +2572,8 @@ but switching to `ash` is generally much preferable. --- ** Some functions and variables obsolete since Emacs 23 have been removed: 'find-emacs-lisp-shadows', 'newsticker-cache-filename', -'redisplay-end-trigger-functions', 'set-window-redisplay-end-trigger', +'process-filter-multibyte-p', 'redisplay-end-trigger-functions', +'set-process-filter-multibyte', 'set-window-redisplay-end-trigger', 'unify-8859-on-decoding-mode', 'unify-8859-on-encoding-mode', 'vc-arch-command', 'window-redisplay-end-trigger', 'x-selection'. @@ -2573,10 +2613,46 @@ abbrevlist.el, assoc.el, complete.el, cust-print.el, erc-hecomplete.el, mailpost.el, mouse-sel.el, old-emacs-lock.el, patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el. ++++ +** Many seldom-used generalized variables have been made obsolete. +Emacs has a number of rather obscure generalized variables defined, +that, for instance, allowed you to say things like: + + (setf (point-min) 4) + +These never caught on and have been made obsolete. The form above, +for instance, is the same as saying + + (narrow-to-region 4 (point-max)) + +The following generalized variables have been made obsolete: +'buffer-file-name', 'buffer-local-value', 'buffer-modified-p', +'buffer-name', 'buffer-string', 'buffer-substring', 'current-buffer', +'current-column', 'current-global-map', 'current-input-mode', +'current-local-map', 'current-window-configuration', +'default-file-modes', 'documentation-property', 'frame-height', +'frame-width', 'frame-visible-p', 'global-key-binding', +'local-key-binding', 'mark', 'mark-marker', 'marker-position', +'mouse-position', 'point', 'point-marker', 'point-max', 'point-min', +'read-mouse-position', 'screen-height', 'screen-width', +'selected-frame', 'selected-screen', 'selected-window', +'standard-case-table', 'syntax-table', 'visited-file-modtime', +'window-height', 'window-width', and 'x-get-secondary-selection'. + * Lisp Changes in Emacs 29.1 +++ +** New function 'make-obsolete-generalized-variable'. +This can be used to mark setters used by 'setf' as obsolete, and the +byte-compiler will then warn about using them. + ++++ +** New functions 'pos-eol' and 'pos-bol'. +These are like 'line-end-position' and 'line-beginning-position' +(respectively), but ignore fields (and are more efficient). + ++++ ** New function 'compiled-function-p'. This returns non-nil if its argument is either a built-in, or a byte-compiled, or a natively-compiled function object, or a function diff --git a/etc/NEWS.28 b/etc/NEWS.28 index 136084e419f..01e8ac112f9 100644 --- a/etc/NEWS.28 +++ b/etc/NEWS.28 @@ -3168,9 +3168,9 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. 'nnmail-fix-eudora-headers', 'non-iso-charset-alist', 'nonascii-insert-offset', 'nonascii-translation-table', 'password-read-and-add', 'pre-abbrev-expand-hook', 'princ-list', -'print-help-return-message', 'process-filter-multibyte-p', -'read-file-name-predicate', 'remember-buffer', 'rmail-highlight-face', -'rmail-message-filter', 'semantic-after-idle-scheduler-reparse-hooks', +'print-help-return-message', 'read-file-name-predicate', +'remember-buffer', 'rmail-highlight-face', 'rmail-message-filter', +'semantic-after-idle-scheduler-reparse-hooks', 'semantic-after-toplevel-bovinate-hook', 'semantic-before-idle-scheduler-reparse-hooks', 'semantic-before-toplevel-bovination-hook', @@ -3196,9 +3196,9 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. 'semantic-something-to-stream', 'semantic-tag-make-assoc-list', 'semantic-token-type-parent', 'semantic-toplevel-bovine-cache', 'semantic-toplevel-bovine-table', 'semanticdb-mode-hooks', -'set-coding-priority', 'set-process-filter-multibyte', -'shadows-compare-text-p', 'shell-dirtrack-toggle', -'speedbar-navigating-speed', 'speedbar-update-speed', 't-mouse-mode', +'set-coding-priority', 'shadows-compare-text-p', +'shell-dirtrack-toggle', 'speedbar-navigating-speed', +'speedbar-update-speed', 't-mouse-mode', 'term-dynamic-simple-complete', 'tooltip-hook', 'tpu-have-ispell', 'url-generate-unique-filename', 'url-temporary-directory', 'vc-arch-command', 'vc-default-working-revision' (variable), diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index 880a8353417..a2329e6ea4f 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -33,7 +33,10 @@ import lldb # Return the name of enumerator ENUM as a string. def enumerator_name(enum): enumerators = enum.GetType().GetEnumMembers() - return enumerators[enum.GetValueAsUnsigned()].GetName() + for enum_member in enumerators: + if enum.GetValueAsUnsigned() == enum_member.GetValueAsUnsigned(): + return enum_member.GetName() + return None # A class wrapping an SBValue for a Lisp_Object, providing convenience # functions. @@ -91,7 +94,6 @@ class Lisp_Object: self.unsigned = lisp_word.GetValueAsUnsigned() else: self.unsigned = self.lisp_obj.GetValueAsUnsigned() - pass # Initialize self.lisp_type to the C Lisp_Type enumerator of the # Lisp_Object, as a string. Initialize self.pvec_type likewise to diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index 20af99df941..fd7ffff98ff 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -6,7 +6,7 @@ ;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> ;; URL: https://git.sr.ht/~protesilaos/modus-themes ;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes -;; Version: 2.5.0 +;; Version: 2.6.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index e64a11b74f5..c4edb1efcb8 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -6,7 +6,7 @@ ;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> ;; URL: https://git.sr.ht/~protesilaos/modus-themes ;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes -;; Version: 2.5.0 +;; Version: 2.6.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -103,19 +103,19 @@ cover the blue-cyan-magenta side of the spectrum." :tag "Modus Themes") (defgroup modus-themes-faces () - "Faces defined my `modus-operandi' and `modus-vivendi'." + "Faces defined by `modus-operandi' and `modus-vivendi'." :group 'modus-themes :link '(info-link "(modus-themes) Top") :prefix "modus-themes-" :tag "Modus Themes Faces") -(defvar modus-themes--version "2.5.0" +(defvar modus-themes--version "2.6.0" "Current version of the Modus themes. -The version either is the last tagged release, such as '2.4.0', -or an in-development version like '2.5.0-dev'. As we use -semantic versioning, tags of the '2.4.1' sort are not reported: -those would count as part of '2.5.0-dev'.") +The version either is the last tagged release, such as '1.0.0', +or an in-development version like '1.1.0-dev'. As we use +semantic versioning, tags of the '1.0.1' sort are not reported: +those would count as part of '1.1.0-dev'.") ;;;###autoload (defun modus-themes-version (&optional insert) @@ -2270,7 +2270,7 @@ follows (order is not significant): The `popup' key takes the same values as `selection'. -Apart from specifying each key separately, a fallback list is +Apart from specfying each key separately, a fallback list is accepted. This is only useful when the desired aesthetic is the same across all keys that are not explicitly referenced. For example, this: @@ -3239,7 +3239,7 @@ an alternative to the default value." "Search for `modus-themes--heading' weight in LIST." (catch 'found (dolist (elt list) - (when (memq elt modus-themes--heading-weights) + (when (memq elt modus-themes-weights) (throw 'found elt))))) (defun modus-themes--heading (level fg fg-alt bg bg-gray border) @@ -4782,6 +4782,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(consult-narrow-indicator ((,class :foreground ,magenta-alt))) `(consult-preview-cursor ((,class :inherit modus-themes-intense-blue))) `(consult-preview-error ((,class :inherit modus-themes-intense-red))) + `(consult-preview-insertion ((,class :inherit modus-themes-special-warm))) `(consult-preview-line ((,class :background ,bg-hl-alt-intense))) ;;;;; corfu `(corfu-current ((,class :inherit modus-themes-completion-selected-popup))) @@ -5464,8 +5465,8 @@ by virtue of calling either of `modus-themes-load-operandi' and cyan cyan-faint blue-alt blue-alt-faint)))) `(font-lock-warning-face ((,class :inherit modus-themes-bold - ,@(modus-themes--syntax-foreground - yellow yellow-alt-faint)))) + ,@(modus-themes--syntax-comment + yellow red yellow-alt-faint red-faint)))) ;;;;; forge `(forge-post-author ((,class :inherit bold :foreground ,fg-main))) `(forge-post-date ((,class :foreground ,fg-special-cold))) @@ -6182,7 +6183,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(markdown-comment-face ((,class :inherit font-lock-comment-face))) `(markdown-footnote-marker-face ((,class :inherit bold :foreground ,cyan-alt))) `(markdown-footnote-text-face ((,class :inherit modus-themes-slant :foreground ,fg-main))) - `(markdown-gfm-checkbox-face ((,class :foreground ,cyan-alt-other))) + `(markdown-gfm-checkbox-face ((,class :foreground ,yellow-alt-other))) `(markdown-header-delimiter-face ((,class :inherit modus-themes-bold :foreground ,fg-dim))) `(markdown-header-face ((t nil))) `(markdown-header-face-1 ((,class :inherit modus-themes-heading-1))) @@ -6357,6 +6358,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(mu4e-moved-face ((,class :inherit modus-themes-slant :foreground ,yellow))) `(mu4e-ok-face ((,class :inherit bold :foreground ,green))) `(mu4e-region-code ((,class :inherit modus-themes-special-calm))) + `(mu4e-related-face ((,class :inherit (italic shadow)))) `(mu4e-replied-face ((,class :foreground ,blue))) `(mu4e-special-header-value-face ((,class :inherit message-header-subject))) `(mu4e-system-face ((,class :inherit modus-themes-slant :foreground ,fg-mark-del))) @@ -6496,7 +6498,7 @@ by virtue of calling either of `modus-themes-load-operandi' and bg-dim fg-special-cold bg-alt fg-alt)))) `(org-block-end-line ((,class :inherit org-block-begin-line))) - `(org-checkbox (( ))) + `(org-checkbox ((,class :foreground ,yellow-alt-other))) `(org-checkbox-statistics-done ((,class :inherit org-done))) `(org-checkbox-statistics-todo ((,class :inherit org-todo))) `(org-clock-overlay ((,class :background ,yellow-nuanced-bg :foreground ,red-alt-faint))) @@ -6963,11 +6965,6 @@ by virtue of calling either of `modus-themes-load-operandi' and `(smerge-refined-changed (())) `(smerge-refined-removed ((,class :inherit modus-themes-diff-refine-removed))) `(smerge-upper ((,class :inherit modus-themes-diff-removed))) -;;;;; solaire - `(solaire-default-face ((,class :inherit default :background ,bg-alt :foreground ,fg-dim))) - `(solaire-line-number-face ((,class :inherit solaire-default-face :foreground ,fg-unfocused))) - `(solaire-hl-line-face ((,class :background ,bg-active))) - `(solaire-org-hide-face ((,class :background ,bg-alt :foreground ,bg-alt))) ;;;;; spaceline `(spaceline-evil-emacs ((,class :inherit modus-themes-active-magenta))) `(spaceline-evil-insert ((,class :inherit modus-themes-active-green))) diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index f2c916ef30a..ba75a2527da 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -6,7 +6,7 @@ ;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht> ;; URL: https://git.sr.ht/~protesilaos/modus-themes ;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes -;; Version: 2.5.0 +;; Version: 2.6.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 2ffe89d4239..5bb78740d6a 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -318,6 +318,7 @@ GL_GENERATE_IEEE754_H_CONDITION = @GL_GENERATE_IEEE754_H_CONDITION@ GL_GENERATE_LIMITS_H_CONDITION = @GL_GENERATE_LIMITS_H_CONDITION@ GL_GENERATE_MINI_GMP_H_CONDITION = @GL_GENERATE_MINI_GMP_H_CONDITION@ GL_GENERATE_STDALIGN_H_CONDITION = @GL_GENERATE_STDALIGN_H_CONDITION@ +GL_GENERATE_STDCKDINT_H_CONDITION = @GL_GENERATE_STDCKDINT_H_CONDITION@ GL_GENERATE_STDDEF_H_CONDITION = @GL_GENERATE_STDDEF_H_CONDITION@ GL_GENERATE_STDINT_H_CONDITION = @GL_GENERATE_STDINT_H_CONDITION@ GL_GNULIB_ACCESS = @GL_GNULIB_ACCESS@ @@ -1198,10 +1199,12 @@ SETTINGS_CFLAGS = @SETTINGS_CFLAGS@ SETTINGS_LIBS = @SETTINGS_LIBS@ SHELL = @SHELL@ SIG_ATOMIC_T_SUFFIX = @SIG_ATOMIC_T_SUFFIX@ +SIZEOF_LONG = @SIZEOF_LONG@ SIZE_T_SUFFIX = @SIZE_T_SUFFIX@ SMALL_JA_DIC = @SMALL_JA_DIC@ SQLITE3_LIBS = @SQLITE3_LIBS@ STDALIGN_H = @STDALIGN_H@ +STDCKDINT_H = @STDCKDINT_H@ STDDEF_H = @STDDEF_H@ STDINT_H = @STDINT_H@ SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@ @@ -1318,6 +1321,7 @@ gl_GNULIB_ENABLED_lchmod_CONDITION = @gl_GNULIB_ENABLED_lchmod_CONDITION@ gl_GNULIB_ENABLED_open_CONDITION = @gl_GNULIB_ENABLED_open_CONDITION@ gl_GNULIB_ENABLED_rawmemchr_CONDITION = @gl_GNULIB_ENABLED_rawmemchr_CONDITION@ gl_GNULIB_ENABLED_scratch_buffer_CONDITION = @gl_GNULIB_ENABLED_scratch_buffer_CONDITION@ +gl_GNULIB_ENABLED_stdckdint_CONDITION = @gl_GNULIB_ENABLED_stdckdint_CONDITION@ gl_GNULIB_ENABLED_strtoll_CONDITION = @gl_GNULIB_ENABLED_strtoll_CONDITION@ gl_GNULIB_ENABLED_utimens_CONDITION = @gl_GNULIB_ENABLED_utimens_CONDITION@ gl_LIBOBJDEPS = @gl_LIBOBJDEPS@ @@ -2267,7 +2271,7 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_intprops)) -EXTRA_DIST += intprops.h +EXTRA_DIST += intprops-internal.h intprops.h endif ## end gnulib module intprops @@ -2872,6 +2876,31 @@ EXTRA_DIST += stdalign.in.h endif ## end gnulib module stdalign +## begin gnulib module stdckdint +ifeq (,$(OMIT_GNULIB_MODULE_stdckdint)) + +ifneq (,$(gl_GNULIB_ENABLED_stdckdint_CONDITION)) +BUILT_SOURCES += $(STDCKDINT_H) + +# We need the following in order to create <stdckdint.h> when the system +# doesn't have one that works with the given compiler. +ifneq (,$(GL_GENERATE_STDCKDINT_H_CONDITION)) +stdckdint.h: stdckdint.in.h $(top_builddir)/config.status + $(gl_V_at)$(SED_HEADER_STDOUT) \ + $(srcdir)/stdckdint.in.h > $@-t + $(AM_V_at)mv $@-t $@ +else +stdckdint.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += stdckdint.h stdckdint.h-t + +endif +EXTRA_DIST += intprops-internal.h stdckdint.in.h + +endif +## end gnulib module stdckdint + ## begin gnulib module stddef ifeq (,$(OMIT_GNULIB_MODULE_stddef)) diff --git a/lib/group-member.c b/lib/group-member.c index 480a12616a2..cd43f36f4eb 100644 --- a/lib/group-member.c +++ b/lib/group-member.c @@ -21,12 +21,11 @@ /* Specification. */ #include <unistd.h> +#include <stdckdint.h> #include <stdio.h> #include <sys/types.h> #include <stdlib.h> -#include "intprops.h" - /* Most processes have no more than this many groups, and for these processes we can avoid using malloc. */ enum { GROUPBUF_SIZE = 100 }; @@ -54,7 +53,7 @@ get_group_info (struct group_info *gi) { int n_group_slots = getgroups (0, NULL); size_t nbytes; - if (! INT_MULTIPLY_WRAPV (n_group_slots, sizeof *gi->group, &nbytes)) + if (! ckd_mul (&nbytes, n_group_slots, sizeof *gi->group)) { gi->group = malloc (nbytes); if (gi->group) diff --git a/lib/intprops-internal.h b/lib/intprops-internal.h new file mode 100644 index 00000000000..f6455f78559 --- /dev/null +++ b/lib/intprops-internal.h @@ -0,0 +1,392 @@ +/* intprops-internal.h -- properties of integer types not visible to users + + Copyright (C) 2001-2022 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify it + under the terms of the GNU Lesser General Public License as published + by the Free Software Foundation; either version 2.1 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see <https://www.gnu.org/licenses/>. */ + +#ifndef _GL_INTPROPS_INTERNAL_H +#define _GL_INTPROPS_INTERNAL_H + +#include <limits.h> + +/* Return a value with the common real type of E and V and the value of V. + Do not evaluate E. */ +#define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v)) + +/* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see + <https://lists.gnu.org/r/bug-gnulib/2011-05/msg00406.html>. */ +#define _GL_INT_NEGATE_CONVERT(e, v) ((1 ? 0 : (e)) - (v)) + +/* The extra casts in the following macros work around compiler bugs, + e.g., in Cray C 5.0.3.0. */ + +/* True if the real type T is signed. */ +#define _GL_TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) + +/* Return 1 if the real expression E, after promotion, has a + signed or floating type. Do not evaluate E. */ +#define _GL_EXPR_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0) + + +/* Minimum and maximum values for integer types and expressions. */ + +/* The width in bits of the integer type or expression T. + Do not evaluate T. T must not be a bit-field expression. + Padding bits are not supported; this is checked at compile-time below. */ +#define _GL_TYPE_WIDTH(t) (sizeof (t) * CHAR_BIT) + +/* The maximum and minimum values for the type of the expression E, + after integer promotion. E is not evaluated. */ +#define _GL_INT_MINIMUM(e) \ + (_GL_EXPR_SIGNED (e) \ + ? ~ _GL_SIGNED_INT_MAXIMUM (e) \ + : _GL_INT_CONVERT (e, 0)) +#define _GL_INT_MAXIMUM(e) \ + (_GL_EXPR_SIGNED (e) \ + ? _GL_SIGNED_INT_MAXIMUM (e) \ + : _GL_INT_NEGATE_CONVERT (e, 1)) +#define _GL_SIGNED_INT_MAXIMUM(e) \ + (((_GL_INT_CONVERT (e, 1) << (_GL_TYPE_WIDTH (+ (e)) - 2)) - 1) * 2 + 1) + +/* Work around OpenVMS incompatibility with C99. */ +#if !defined LLONG_MAX && defined __INT64_MAX +# define LLONG_MAX __INT64_MAX +# define LLONG_MIN __INT64_MIN +#endif + +/* This include file assumes that signed types are two's complement without + padding bits; the above macros have undefined behavior otherwise. + If this is a problem for you, please let us know how to fix it for your host. + This assumption is tested by the intprops-tests module. */ + +/* Does the __typeof__ keyword work? This could be done by + 'configure', but for now it's easier to do it by hand. */ +#if (2 <= __GNUC__ \ + || (4 <= __clang_major__) \ + || (1210 <= __IBMC__ && defined __IBM__TYPEOF__) \ + || (0x5110 <= __SUNPRO_C && !__STDC__)) +# define _GL_HAVE___TYPEOF__ 1 +#else +# define _GL_HAVE___TYPEOF__ 0 +#endif + +/* Return 1 if the integer type or expression T might be signed. Return 0 + if it is definitely unsigned. T must not be a bit-field expression. + This macro does not evaluate its argument, and expands to an + integer constant expression. */ +#if _GL_HAVE___TYPEOF__ +# define _GL_SIGNED_TYPE_OR_EXPR(t) _GL_TYPE_SIGNED (__typeof__ (t)) +#else +# define _GL_SIGNED_TYPE_OR_EXPR(t) 1 +#endif + +/* Return 1 if - A would overflow in [MIN,MAX] arithmetic. + A should not have side effects, and A's type should be an + integer with minimum value MIN and maximum MAX. */ +#define _GL_INT_NEGATE_RANGE_OVERFLOW(a, min, max) \ + ((min) < 0 ? (a) < - (max) : 0 < (a)) + +/* True if __builtin_add_overflow (A, B, P) and __builtin_sub_overflow + (A, B, P) work when P is non-null. */ +#ifdef __EDG__ +/* EDG-based compilers like nvc 22.1 cannot add 64-bit signed to unsigned + <https://bugs.gnu.org/53256>. */ +# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 +#elif defined __has_builtin +# define _GL_HAS_BUILTIN_ADD_OVERFLOW __has_builtin (__builtin_add_overflow) +/* __builtin_{add,sub}_overflow exists but is not reliable in GCC 5.x and 6.x, + see <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=98269>. */ +#elif 7 <= __GNUC__ +# define _GL_HAS_BUILTIN_ADD_OVERFLOW 1 +#else +# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 +#endif + +/* True if __builtin_mul_overflow (A, B, P) works when P is non-null. */ +#if defined __clang_major__ && __clang_major__ < 14 +/* Work around Clang bug <https://bugs.llvm.org/show_bug.cgi?id=16404>. */ +# define _GL_HAS_BUILTIN_MUL_OVERFLOW 0 +#else +# define _GL_HAS_BUILTIN_MUL_OVERFLOW _GL_HAS_BUILTIN_ADD_OVERFLOW +#endif + +/* True if __builtin_add_overflow_p (A, B, C) works, and similarly for + __builtin_sub_overflow_p and __builtin_mul_overflow_p. */ +#ifdef __EDG__ +/* In EDG-based compilers like ICC 2021.3 and earlier, + __builtin_add_overflow_p etc. are not treated as integral constant + expressions even when all arguments are. */ +# define _GL_HAS_BUILTIN_OVERFLOW_P 0 +#elif defined __has_builtin +# define _GL_HAS_BUILTIN_OVERFLOW_P __has_builtin (__builtin_mul_overflow_p) +#else +# define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__) +#endif + +#if (!defined _GL_STDCKDINT_H && 202311 <= __STDC_VERSION__ \ + && ! (_GL_HAS_BUILTIN_ADD_OVERFLOW && _GL_HAS_BUILTIN_MUL_OVERFLOW)) +# include <stdckdint.h> +#endif + +/* Store the low-order bits of A + B, A - B, A * B, respectively, into *R. + Return 1 if the result overflows. Arguments should not have side + effects and A, B and *R can be of any integer type other than char, + bool, a bit-precise integer type, or an enumeration type. */ +#if _GL_HAS_BUILTIN_ADD_OVERFLOW +# define _GL_INT_ADD_WRAPV(a, b, r) __builtin_add_overflow (a, b, r) +# define _GL_INT_SUBTRACT_WRAPV(a, b, r) __builtin_sub_overflow (a, b, r) +#elif defined ckd_add && defined ckd_sub && !defined _GL_STDCKDINT_H +# define _GL_INT_ADD_WRAPV(a, b, r) ckd_add (r, + (a), + (b)) +# define _GL_INT_SUBTRACT_WRAPV(a, b, r) ckd_sub (r, + (a), + (b)) +#else +# define _GL_INT_ADD_WRAPV(a, b, r) \ + _GL_INT_OP_WRAPV (a, b, r, +, _GL_INT_ADD_RANGE_OVERFLOW) +# define _GL_INT_SUBTRACT_WRAPV(a, b, r) \ + _GL_INT_OP_WRAPV (a, b, r, -, _GL_INT_SUBTRACT_RANGE_OVERFLOW) +#endif +#if _GL_HAS_BUILTIN_MUL_OVERFLOW +# if ((9 < __GNUC__ + (3 <= __GNUC_MINOR__) \ + || (__GNUC__ == 8 && 4 <= __GNUC_MINOR__)) \ + && !defined __EDG__) +# define _GL_INT_MULTIPLY_WRAPV(a, b, r) __builtin_mul_overflow (a, b, r) +# else + /* Work around GCC bug 91450. */ +# define _GL_INT_MULTIPLY_WRAPV(a, b, r) \ + ((!_GL_SIGNED_TYPE_OR_EXPR (*(r)) && _GL_EXPR_SIGNED (a) && _GL_EXPR_SIGNED (b) \ + && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, 0, (__typeof__ (*(r))) -1)) \ + ? ((void) __builtin_mul_overflow (a, b, r), 1) \ + : __builtin_mul_overflow (a, b, r)) +# endif +#elif defined ckd_mul && !defined _GL_STDCKDINT_H +# define _GL_INT_MULTIPLY_WRAPV(a, b, r) ckd_mul (r, + (a), + (b)) +#else +# define _GL_INT_MULTIPLY_WRAPV(a, b, r) \ + _GL_INT_OP_WRAPV (a, b, r, *, _GL_INT_MULTIPLY_RANGE_OVERFLOW) +#endif + +/* Nonzero if this compiler has GCC bug 68193 or Clang bug 25390. See: + https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68193 + https://llvm.org/bugs/show_bug.cgi?id=25390 + For now, assume all versions of GCC-like compilers generate bogus + warnings for _Generic. This matters only for compilers that + lack relevant builtins. */ +#if __GNUC__ || defined __clang__ +# define _GL__GENERIC_BOGUS 1 +#else +# define _GL__GENERIC_BOGUS 0 +#endif + +/* Store the low-order bits of A <op> B into *R, where OP specifies + the operation and OVERFLOW the overflow predicate. Return 1 if the + result overflows. Arguments should not have side effects, + and A, B and *R can be of any integer type other than char, bool, a + bit-precise integer type, or an enumeration type. */ +#if 201112 <= __STDC_VERSION__ && !_GL__GENERIC_BOGUS +# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \ + (_Generic \ + (*(r), \ + signed char: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + signed char, SCHAR_MIN, SCHAR_MAX), \ + unsigned char: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + unsigned char, 0, UCHAR_MAX), \ + short int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + short int, SHRT_MIN, SHRT_MAX), \ + unsigned short int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + unsigned short int, 0, USHRT_MAX), \ + int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + int, INT_MIN, INT_MAX), \ + unsigned int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + unsigned int, 0, UINT_MAX), \ + long int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + long int, LONG_MIN, LONG_MAX), \ + unsigned long int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + unsigned long int, 0, ULONG_MAX), \ + long long int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ + long long int, LLONG_MIN, LLONG_MAX), \ + unsigned long long int: \ + _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ + unsigned long long int, 0, ULLONG_MAX))) +#else +/* Store the low-order bits of A <op> B into *R, where OP specifies + the operation and OVERFLOW the overflow predicate. If *R is + signed, its type is ST with bounds SMIN..SMAX; otherwise its type + is UT with bounds U..UMAX. ST and UT are narrower than int. + Return 1 if the result overflows. Arguments should not have side + effects, and A, B and *R can be of any integer type other than + char, bool, a bit-precise integer type, or an enumeration type. */ +# if _GL_HAVE___TYPEOF__ +# define _GL_INT_OP_WRAPV_SMALLISH(a,b,r,op,overflow,st,smin,smax,ut,umax) \ + (_GL_TYPE_SIGNED (__typeof__ (*(r))) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, st, smin, smax) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, ut, 0, umax)) +# else +# define _GL_INT_OP_WRAPV_SMALLISH(a,b,r,op,overflow,st,smin,smax,ut,umax) \ + (overflow (a, b, smin, smax) \ + ? (overflow (a, b, 0, umax) \ + ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 1) \ + : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st)) < 0) \ + : (overflow (a, b, 0, umax) \ + ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st)) >= 0 \ + : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 0))) +# endif + +# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \ + (sizeof *(r) == sizeof (signed char) \ + ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \ + signed char, SCHAR_MIN, SCHAR_MAX, \ + unsigned char, UCHAR_MAX) \ + : sizeof *(r) == sizeof (short int) \ + ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \ + short int, SHRT_MIN, SHRT_MAX, \ + unsigned short int, USHRT_MAX) \ + : sizeof *(r) == sizeof (int) \ + ? (_GL_EXPR_SIGNED (*(r)) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + int, INT_MIN, INT_MAX) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ + unsigned int, 0, UINT_MAX)) \ + : _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow)) +# ifdef LLONG_MAX +# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \ + (sizeof *(r) == sizeof (long int) \ + ? (_GL_EXPR_SIGNED (*(r)) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + long int, LONG_MIN, LONG_MAX) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + unsigned long int, 0, ULONG_MAX)) \ + : (_GL_EXPR_SIGNED (*(r)) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ + long long int, LLONG_MIN, LLONG_MAX) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ + unsigned long long int, 0, ULLONG_MAX))) +# else +# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \ + (_GL_EXPR_SIGNED (*(r)) \ + ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + long int, LONG_MIN, LONG_MAX) \ + : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ + unsigned long int, 0, ULONG_MAX)) +# endif +#endif + +/* Store the low-order bits of A <op> B into *R, where the operation + is given by OP. Use the unsigned type UT for calculation to avoid + overflow problems. *R's type is T, with extrema TMIN and TMAX. + T can be any signed integer type other than char, bool, a + bit-precise integer type, or an enumeration type. + Return 1 if the result overflows. */ +#define _GL_INT_OP_CALC(a, b, r, op, overflow, ut, t, tmin, tmax) \ + (overflow (a, b, tmin, tmax) \ + ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t), 1) \ + : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t), 0)) + +/* Return 1 if the integer expressions A - B and -A would overflow, + respectively. Arguments should not have side effects, + and can be any signed integer type other than char, bool, a + bit-precise integer type, or an enumeration type. + These macros are tuned for their last input argument being a constant. */ + +#if _GL_HAS_BUILTIN_OVERFLOW_P +# define _GL_INT_NEGATE_OVERFLOW(a) \ + __builtin_sub_overflow_p (0, a, (__typeof__ (- (a))) 0) +#else +# define _GL_INT_NEGATE_OVERFLOW(a) \ + _GL_INT_NEGATE_RANGE_OVERFLOW (a, _GL_INT_MINIMUM (a), _GL_INT_MAXIMUM (a)) +#endif + +/* Return the low-order bits of A <op> B, where the operation is given + by OP. Use the unsigned type UT for calculation to avoid undefined + behavior on signed integer overflow, and convert the result to type T. + UT is at least as wide as T and is no narrower than unsigned int, + T is two's complement, and there is no padding or trap representations. + Assume that converting UT to T yields the low-order bits, as is + done in all known two's-complement C compilers. E.g., see: + https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html + + According to the C standard, converting UT to T yields an + implementation-defined result or signal for values outside T's + range. However, code that works around this theoretical problem + runs afoul of a compiler bug in Oracle Studio 12.3 x86. See: + https://lists.gnu.org/r/bug-gnulib/2017-04/msg00049.html + As the compiler bug is real, don't try to work around the + theoretical problem. */ + +#define _GL_INT_OP_WRAPV_VIA_UNSIGNED(a, b, op, ut, t) \ + ((t) ((ut) (a) op (ut) (b))) + +/* Return true if the numeric values A + B, A - B, A * B fall outside + the range TMIN..TMAX. Arguments should not have side effects + and can be any integer type other than char, bool, + a bit-precise integer type, or an enumeration type. + TMIN should be signed and nonpositive. + TMAX should be positive, and should be signed unless TMIN is zero. */ +#define _GL_INT_ADD_RANGE_OVERFLOW(a, b, tmin, tmax) \ + ((b) < 0 \ + ? (((tmin) \ + ? ((_GL_EXPR_SIGNED (_GL_INT_CONVERT (a, (tmin) - (b))) || (b) < (tmin)) \ + && (a) < (tmin) - (b)) \ + : (a) <= -1 - (b)) \ + || ((_GL_EXPR_SIGNED (a) ? 0 <= (a) : (tmax) < (a)) && (tmax) < (a) + (b))) \ + : (a) < 0 \ + ? (((tmin) \ + ? ((_GL_EXPR_SIGNED (_GL_INT_CONVERT (b, (tmin) - (a))) || (a) < (tmin)) \ + && (b) < (tmin) - (a)) \ + : (b) <= -1 - (a)) \ + || ((_GL_EXPR_SIGNED (_GL_INT_CONVERT (a, b)) || (tmax) < (b)) \ + && (tmax) < (a) + (b))) \ + : (tmax) < (b) || (tmax) - (b) < (a)) +#define _GL_INT_SUBTRACT_RANGE_OVERFLOW(a, b, tmin, tmax) \ + (((a) < 0) == ((b) < 0) \ + ? ((a) < (b) \ + ? !(tmin) || -1 - (tmin) < (b) - (a) - 1 \ + : (tmax) < (a) - (b)) \ + : (a) < 0 \ + ? ((!_GL_EXPR_SIGNED (_GL_INT_CONVERT ((a) - (tmin), b)) && (a) - (tmin) < 0) \ + || (a) - (tmin) < (b)) \ + : ((! (_GL_EXPR_SIGNED (_GL_INT_CONVERT (tmax, b)) \ + && _GL_EXPR_SIGNED (_GL_INT_CONVERT ((tmax) + (b), a))) \ + && (tmax) <= -1 - (b)) \ + || (tmax) + (b) < (a))) +#define _GL_INT_MULTIPLY_RANGE_OVERFLOW(a, b, tmin, tmax) \ + ((b) < 0 \ + ? ((a) < 0 \ + ? (_GL_EXPR_SIGNED (_GL_INT_CONVERT (tmax, b)) \ + ? (a) < (tmax) / (b) \ + : ((_GL_INT_NEGATE_OVERFLOW (b) \ + ? _GL_INT_CONVERT (b, tmax) >> (_GL_TYPE_WIDTH (+ (b)) - 1) \ + : (tmax) / -(b)) \ + <= -1 - (a))) \ + : _GL_INT_NEGATE_OVERFLOW (_GL_INT_CONVERT (b, tmin)) && (b) == -1 \ + ? (_GL_EXPR_SIGNED (a) \ + ? 0 < (a) + (tmin) \ + : 0 < (a) && -1 - (tmin) < (a) - 1) \ + : (tmin) / (b) < (a)) \ + : (b) == 0 \ + ? 0 \ + : ((a) < 0 \ + ? (_GL_INT_NEGATE_OVERFLOW (_GL_INT_CONVERT (a, tmin)) && (a) == -1 \ + ? (_GL_EXPR_SIGNED (b) ? 0 < (b) + (tmin) : -1 - (tmin) < (b) - 1) \ + : (tmin) / (a) < (b)) \ + : (tmax) / (b) < (a))) + +#endif /* _GL_INTPROPS_INTERNAL_H */ diff --git a/lib/intprops.h b/lib/intprops.h index d4a917f72a0..f182ddc1fe6 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -15,19 +15,10 @@ You should have received a copy of the GNU Lesser General Public License along with this program. If not, see <https://www.gnu.org/licenses/>. */ - #ifndef _GL_INTPROPS_H #define _GL_INTPROPS_H -#include <limits.h> - -/* Return a value with the common real type of E and V and the value of V. - Do not evaluate E. */ -#define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v)) - -/* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see - <https://lists.gnu.org/r/bug-gnulib/2011-05/msg00406.html>. */ -#define _GL_INT_NEGATE_CONVERT(e, v) ((1 ? 0 : (e)) - (v)) +#include "intprops-internal.h" /* The extra casts in the following macros work around compiler bugs, e.g., in Cray C 5.0.3.0. */ @@ -37,11 +28,11 @@ #define TYPE_IS_INTEGER(t) ((t) 1.5 == 1) /* True if the real type T is signed. */ -#define TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) +#define TYPE_SIGNED(t) _GL_TYPE_SIGNED (t) /* Return 1 if the real expression E, after promotion, has a signed or floating type. Do not evaluate E. */ -#define EXPR_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0) +#define EXPR_SIGNED(e) _GL_EXPR_SIGNED (e) /* Minimum and maximum values for integer types and expressions. */ @@ -49,7 +40,7 @@ /* The width in bits of the integer type or expression T. Do not evaluate T. T must not be a bit-field expression. Padding bits are not supported; this is checked at compile-time below. */ -#define TYPE_WIDTH(t) (sizeof (t) * CHAR_BIT) +#define TYPE_WIDTH(t) _GL_TYPE_WIDTH (t) /* The maximum and minimum values for the integer type T. */ #define TYPE_MINIMUM(t) ((t) ~ TYPE_MAXIMUM (t)) @@ -58,51 +49,6 @@ ? (t) -1 \ : ((((t) 1 << (TYPE_WIDTH (t) - 2)) - 1) * 2 + 1))) -/* The maximum and minimum values for the type of the expression E, - after integer promotion. E is not evaluated. */ -#define _GL_INT_MINIMUM(e) \ - (EXPR_SIGNED (e) \ - ? ~ _GL_SIGNED_INT_MAXIMUM (e) \ - : _GL_INT_CONVERT (e, 0)) -#define _GL_INT_MAXIMUM(e) \ - (EXPR_SIGNED (e) \ - ? _GL_SIGNED_INT_MAXIMUM (e) \ - : _GL_INT_NEGATE_CONVERT (e, 1)) -#define _GL_SIGNED_INT_MAXIMUM(e) \ - (((_GL_INT_CONVERT (e, 1) << (TYPE_WIDTH (+ (e)) - 2)) - 1) * 2 + 1) - -/* Work around OpenVMS incompatibility with C99. */ -#if !defined LLONG_MAX && defined __INT64_MAX -# define LLONG_MAX __INT64_MAX -# define LLONG_MIN __INT64_MIN -#endif - -/* This include file assumes that signed types are two's complement without - padding bits; the above macros have undefined behavior otherwise. - If this is a problem for you, please let us know how to fix it for your host. - This assumption is tested by the intprops-tests module. */ - -/* Does the __typeof__ keyword work? This could be done by - 'configure', but for now it's easier to do it by hand. */ -#if (2 <= __GNUC__ \ - || (4 <= __clang_major__) \ - || (1210 <= __IBMC__ && defined __IBM__TYPEOF__) \ - || (0x5110 <= __SUNPRO_C && !__STDC__)) -# define _GL_HAVE___TYPEOF__ 1 -#else -# define _GL_HAVE___TYPEOF__ 0 -#endif - -/* Return 1 if the integer type or expression T might be signed. Return 0 - if it is definitely unsigned. T must not be a bit-field expression. - This macro does not evaluate its argument, and expands to an - integer constant expression. */ -#if _GL_HAVE___TYPEOF__ -# define _GL_SIGNED_TYPE_OR_EXPR(t) TYPE_SIGNED (__typeof__ (t)) -#else -# define _GL_SIGNED_TYPE_OR_EXPR(t) 1 -#endif - /* Bound on length of the string representing an unsigned integer value representable in B bits. log10 (2.0) < 146/485. The smallest value of B where this bound is not tight is 2621. */ @@ -129,12 +75,11 @@ /* Range overflow checks. The INT_<op>_RANGE_OVERFLOW macros return 1 if the corresponding C - operators might not yield numerically correct answers due to - arithmetic overflow. They do not rely on undefined or - implementation-defined behavior. Their implementations are simple - and straightforward, but they are harder to use and may be less - efficient than the INT_<op>_WRAPV, INT_<op>_OK, and - INT_<op>_OVERFLOW macros described below. + operators overflow arithmetically when given the same arguments. + These macros do not rely on undefined or implementation-defined behavior. + Although their implementations are simple and straightforward, + they are harder to use and may be less efficient than the + INT_<op>_WRAPV, INT_<op>_OK, and INT_<op>_OVERFLOW macros described below. Example usage: @@ -181,9 +126,7 @@ /* Return 1 if - A would overflow in [MIN,MAX] arithmetic. See above for restrictions. */ #define INT_NEGATE_RANGE_OVERFLOW(a, min, max) \ - ((min) < 0 \ - ? (a) < - (max) \ - : 0 < (a)) + _GL_INT_NEGATE_RANGE_OVERFLOW (a, min, max) /* Return 1 if A * B would overflow in [MIN,MAX] arithmetic. See above for restrictions. Avoid && and || as they tickle @@ -227,43 +170,6 @@ ? (a) < (min) >> (b) \ : (max) >> (b) < (a)) -/* True if __builtin_add_overflow (A, B, P) and __builtin_sub_overflow - (A, B, P) work when P is non-null. */ -#ifdef __EDG__ -/* EDG-based compilers like nvc 22.1 cannot add 64-bit signed to unsigned - <https://bugs.gnu.org/53256>. */ -# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 -#elif defined __has_builtin -# define _GL_HAS_BUILTIN_ADD_OVERFLOW __has_builtin (__builtin_add_overflow) -/* __builtin_{add,sub}_overflow exists but is not reliable in GCC 5.x and 6.x, - see <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=98269>. */ -#elif 7 <= __GNUC__ -# define _GL_HAS_BUILTIN_ADD_OVERFLOW 1 -#else -# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 -#endif - -/* True if __builtin_mul_overflow (A, B, P) works when P is non-null. */ -#if defined __clang_major__ && __clang_major__ < 14 -/* Work around Clang bug <https://bugs.llvm.org/show_bug.cgi?id=16404>. */ -# define _GL_HAS_BUILTIN_MUL_OVERFLOW 0 -#else -# define _GL_HAS_BUILTIN_MUL_OVERFLOW _GL_HAS_BUILTIN_ADD_OVERFLOW -#endif - -/* True if __builtin_add_overflow_p (A, B, C) works, and similarly for - __builtin_sub_overflow_p and __builtin_mul_overflow_p. */ -#ifdef __EDG__ -/* In EDG-based compilers like ICC 2021.3 and earlier, - __builtin_add_overflow_p etc. are not treated as integral constant - expressions even when all arguments are. */ -# define _GL_HAS_BUILTIN_OVERFLOW_P 0 -#elif defined __has_builtin -# define _GL_HAS_BUILTIN_OVERFLOW_P __has_builtin (__builtin_mul_overflow_p) -#else -# define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__) -#endif - /* The _GL*_OVERFLOW macros have the same restrictions as the *_RANGE_OVERFLOW macros, except that they do not assume that operands (e.g., A and B) have the same type as MIN and MAX. Instead, they assume @@ -350,13 +256,18 @@ Because the WRAPV macros convert the result, they report overflow in different circumstances than the OVERFLOW macros do. For example, in the typical case with 16-bit 'short' and 32-bit 'int', - if A, B and R are all of type 'short' then INT_ADD_OVERFLOW (A, B) + if A, B and *R are all of type 'short' then INT_ADD_OVERFLOW (A, B) returns false because the addition cannot overflow after A and B - are converted to 'int', whereas INT_ADD_WRAPV (A, B, &R) returns + are converted to 'int', whereas INT_ADD_WRAPV (A, B, R) returns true or false depending on whether the sum fits into 'short'. These macros are tuned for their last input argument being a constant. + A, B, and *R should be integers; they need not be the same type, + and they need not be all signed or all unsigned. + However, none of the integer types should be bit-precise, + and *R's type should not be char, bool, or an enumeration type. + Return 1 if the integer expressions A * B, A - B, -A, A * B, A / B, A % B, and A << B would overflow, respectively. */ @@ -364,12 +275,7 @@ _GL_BINARY_OP_OVERFLOW (a, b, _GL_ADD_OVERFLOW) #define INT_SUBTRACT_OVERFLOW(a, b) \ _GL_BINARY_OP_OVERFLOW (a, b, _GL_SUBTRACT_OVERFLOW) -#if _GL_HAS_BUILTIN_OVERFLOW_P -# define INT_NEGATE_OVERFLOW(a) INT_SUBTRACT_OVERFLOW (0, a) -#else -# define INT_NEGATE_OVERFLOW(a) \ - INT_NEGATE_RANGE_OVERFLOW (a, _GL_INT_MINIMUM (a), _GL_INT_MAXIMUM (a)) -#endif +#define INT_NEGATE_OVERFLOW(a) _GL_INT_NEGATE_OVERFLOW (a) #define INT_MULTIPLY_OVERFLOW(a, b) \ _GL_BINARY_OP_OVERFLOW (a, b, _GL_MULTIPLY_OVERFLOW) #define INT_DIVIDE_OVERFLOW(a, b) \ @@ -391,224 +297,9 @@ /* Store the low-order bits of A + B, A - B, A * B, respectively, into *R. Return 1 if the result overflows. See above for restrictions. */ -#if _GL_HAS_BUILTIN_ADD_OVERFLOW -# define INT_ADD_WRAPV(a, b, r) __builtin_add_overflow (a, b, r) -# define INT_SUBTRACT_WRAPV(a, b, r) __builtin_sub_overflow (a, b, r) -#else -# define INT_ADD_WRAPV(a, b, r) \ - _GL_INT_OP_WRAPV (a, b, r, +, _GL_INT_ADD_RANGE_OVERFLOW) -# define INT_SUBTRACT_WRAPV(a, b, r) \ - _GL_INT_OP_WRAPV (a, b, r, -, _GL_INT_SUBTRACT_RANGE_OVERFLOW) -#endif -#if _GL_HAS_BUILTIN_MUL_OVERFLOW -# if ((9 < __GNUC__ + (3 <= __GNUC_MINOR__) \ - || (__GNUC__ == 8 && 4 <= __GNUC_MINOR__)) \ - && !defined __EDG__) -# define INT_MULTIPLY_WRAPV(a, b, r) __builtin_mul_overflow (a, b, r) -# else - /* Work around GCC bug 91450. */ -# define INT_MULTIPLY_WRAPV(a, b, r) \ - ((!_GL_SIGNED_TYPE_OR_EXPR (*(r)) && EXPR_SIGNED (a) && EXPR_SIGNED (b) \ - && _GL_INT_MULTIPLY_RANGE_OVERFLOW (a, b, 0, (__typeof__ (*(r))) -1)) \ - ? ((void) __builtin_mul_overflow (a, b, r), 1) \ - : __builtin_mul_overflow (a, b, r)) -# endif -#else -# define INT_MULTIPLY_WRAPV(a, b, r) \ - _GL_INT_OP_WRAPV (a, b, r, *, _GL_INT_MULTIPLY_RANGE_OVERFLOW) -#endif - -/* Nonzero if this compiler has GCC bug 68193 or Clang bug 25390. See: - https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68193 - https://llvm.org/bugs/show_bug.cgi?id=25390 - For now, assume all versions of GCC-like compilers generate bogus - warnings for _Generic. This matters only for compilers that - lack relevant builtins. */ -#if __GNUC__ || defined __clang__ -# define _GL__GENERIC_BOGUS 1 -#else -# define _GL__GENERIC_BOGUS 0 -#endif - -/* Store the low-order bits of A <op> B into *R, where OP specifies - the operation and OVERFLOW the overflow predicate. Return 1 if the - result overflows. See above for restrictions. */ -#if 201112 <= __STDC_VERSION__ && !_GL__GENERIC_BOGUS -# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \ - (_Generic \ - (*(r), \ - signed char: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - signed char, SCHAR_MIN, SCHAR_MAX), \ - unsigned char: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - unsigned char, 0, UCHAR_MAX), \ - short int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - short int, SHRT_MIN, SHRT_MAX), \ - unsigned short int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - unsigned short int, 0, USHRT_MAX), \ - int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - int, INT_MIN, INT_MAX), \ - unsigned int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - unsigned int, 0, UINT_MAX), \ - long int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - long int, LONG_MIN, LONG_MAX), \ - unsigned long int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - unsigned long int, 0, ULONG_MAX), \ - long long int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ - long long int, LLONG_MIN, LLONG_MAX), \ - unsigned long long int: \ - _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ - unsigned long long int, 0, ULLONG_MAX))) -#else -/* Store the low-order bits of A <op> B into *R, where OP specifies - the operation and OVERFLOW the overflow predicate. If *R is - signed, its type is ST with bounds SMIN..SMAX; otherwise its type - is UT with bounds U..UMAX. ST and UT are narrower than int. - Return 1 if the result overflows. See above for restrictions. */ -# if _GL_HAVE___TYPEOF__ -# define _GL_INT_OP_WRAPV_SMALLISH(a,b,r,op,overflow,st,smin,smax,ut,umax) \ - (TYPE_SIGNED (__typeof__ (*(r))) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, st, smin, smax) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, ut, 0, umax)) -# else -# define _GL_INT_OP_WRAPV_SMALLISH(a,b,r,op,overflow,st,smin,smax,ut,umax) \ - (overflow (a, b, smin, smax) \ - ? (overflow (a, b, 0, umax) \ - ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 1) \ - : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st)) < 0) \ - : (overflow (a, b, 0, umax) \ - ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st)) >= 0 \ - : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a,b,op,unsigned,st), 0))) -# endif - -# define _GL_INT_OP_WRAPV(a, b, r, op, overflow) \ - (sizeof *(r) == sizeof (signed char) \ - ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \ - signed char, SCHAR_MIN, SCHAR_MAX, \ - unsigned char, UCHAR_MAX) \ - : sizeof *(r) == sizeof (short int) \ - ? _GL_INT_OP_WRAPV_SMALLISH (a, b, r, op, overflow, \ - short int, SHRT_MIN, SHRT_MAX, \ - unsigned short int, USHRT_MAX) \ - : sizeof *(r) == sizeof (int) \ - ? (EXPR_SIGNED (*(r)) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - int, INT_MIN, INT_MAX) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \ - unsigned int, 0, UINT_MAX)) \ - : _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow)) -# ifdef LLONG_MAX -# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \ - (sizeof *(r) == sizeof (long int) \ - ? (EXPR_SIGNED (*(r)) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - long int, LONG_MIN, LONG_MAX) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - unsigned long int, 0, ULONG_MAX)) \ - : (EXPR_SIGNED (*(r)) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ - long long int, LLONG_MIN, LLONG_MAX) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \ - unsigned long long int, 0, ULLONG_MAX))) -# else -# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \ - (EXPR_SIGNED (*(r)) \ - ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - long int, LONG_MIN, LONG_MAX) \ - : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \ - unsigned long int, 0, ULONG_MAX)) -# endif -#endif - -/* Store the low-order bits of A <op> B into *R, where the operation - is given by OP. Use the unsigned type UT for calculation to avoid - overflow problems. *R's type is T, with extrema TMIN and TMAX. - T must be a signed integer type. Return 1 if the result overflows. */ -#define _GL_INT_OP_CALC(a, b, r, op, overflow, ut, t, tmin, tmax) \ - (overflow (a, b, tmin, tmax) \ - ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t), 1) \ - : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t), 0)) - -/* Return the low-order bits of A <op> B, where the operation is given - by OP. Use the unsigned type UT for calculation to avoid undefined - behavior on signed integer overflow, and convert the result to type T. - UT is at least as wide as T and is no narrower than unsigned int, - T is two's complement, and there is no padding or trap representations. - Assume that converting UT to T yields the low-order bits, as is - done in all known two's-complement C compilers. E.g., see: - https://gcc.gnu.org/onlinedocs/gcc/Integers-implementation.html - - According to the C standard, converting UT to T yields an - implementation-defined result or signal for values outside T's - range. However, code that works around this theoretical problem - runs afoul of a compiler bug in Oracle Studio 12.3 x86. See: - https://lists.gnu.org/r/bug-gnulib/2017-04/msg00049.html - As the compiler bug is real, don't try to work around the - theoretical problem. */ - -#define _GL_INT_OP_WRAPV_VIA_UNSIGNED(a, b, op, ut, t) \ - ((t) ((ut) (a) op (ut) (b))) - -/* Return true if the numeric values A + B, A - B, A * B fall outside - the range TMIN..TMAX. Arguments should be integer expressions - without side effects. TMIN should be signed and nonpositive. - TMAX should be positive, and should be signed unless TMIN is zero. */ -#define _GL_INT_ADD_RANGE_OVERFLOW(a, b, tmin, tmax) \ - ((b) < 0 \ - ? (((tmin) \ - ? ((EXPR_SIGNED (_GL_INT_CONVERT (a, (tmin) - (b))) || (b) < (tmin)) \ - && (a) < (tmin) - (b)) \ - : (a) <= -1 - (b)) \ - || ((EXPR_SIGNED (a) ? 0 <= (a) : (tmax) < (a)) && (tmax) < (a) + (b))) \ - : (a) < 0 \ - ? (((tmin) \ - ? ((EXPR_SIGNED (_GL_INT_CONVERT (b, (tmin) - (a))) || (a) < (tmin)) \ - && (b) < (tmin) - (a)) \ - : (b) <= -1 - (a)) \ - || ((EXPR_SIGNED (_GL_INT_CONVERT (a, b)) || (tmax) < (b)) \ - && (tmax) < (a) + (b))) \ - : (tmax) < (b) || (tmax) - (b) < (a)) -#define _GL_INT_SUBTRACT_RANGE_OVERFLOW(a, b, tmin, tmax) \ - (((a) < 0) == ((b) < 0) \ - ? ((a) < (b) \ - ? !(tmin) || -1 - (tmin) < (b) - (a) - 1 \ - : (tmax) < (a) - (b)) \ - : (a) < 0 \ - ? ((!EXPR_SIGNED (_GL_INT_CONVERT ((a) - (tmin), b)) && (a) - (tmin) < 0) \ - || (a) - (tmin) < (b)) \ - : ((! (EXPR_SIGNED (_GL_INT_CONVERT (tmax, b)) \ - && EXPR_SIGNED (_GL_INT_CONVERT ((tmax) + (b), a))) \ - && (tmax) <= -1 - (b)) \ - || (tmax) + (b) < (a))) -#define _GL_INT_MULTIPLY_RANGE_OVERFLOW(a, b, tmin, tmax) \ - ((b) < 0 \ - ? ((a) < 0 \ - ? (EXPR_SIGNED (_GL_INT_CONVERT (tmax, b)) \ - ? (a) < (tmax) / (b) \ - : ((INT_NEGATE_OVERFLOW (b) \ - ? _GL_INT_CONVERT (b, tmax) >> (TYPE_WIDTH (+ (b)) - 1) \ - : (tmax) / -(b)) \ - <= -1 - (a))) \ - : INT_NEGATE_OVERFLOW (_GL_INT_CONVERT (b, tmin)) && (b) == -1 \ - ? (EXPR_SIGNED (a) \ - ? 0 < (a) + (tmin) \ - : 0 < (a) && -1 - (tmin) < (a) - 1) \ - : (tmin) / (b) < (a)) \ - : (b) == 0 \ - ? 0 \ - : ((a) < 0 \ - ? (INT_NEGATE_OVERFLOW (_GL_INT_CONVERT (a, tmin)) && (a) == -1 \ - ? (EXPR_SIGNED (b) ? 0 < (b) + (tmin) : -1 - (tmin) < (b) - 1) \ - : (tmin) / (a) < (b)) \ - : (tmax) / (b) < (a))) +#define INT_ADD_WRAPV(a, b, r) _GL_INT_ADD_WRAPV (a, b, r) +#define INT_SUBTRACT_WRAPV(a, b, r) _GL_INT_SUBTRACT_WRAPV (a, b, r) +#define INT_MULTIPLY_WRAPV(a, b, r) _GL_INT_MULTIPLY_WRAPV (a, b, r) /* The following macros compute A + B, A - B, and A * B, respectively. If no overflow occurs, they set *R to the result and return 1; @@ -624,6 +315,8 @@ A, B, and *R should be integers; they need not be the same type, and they need not be all signed or all unsigned. + However, none of the integer types should be bit-precise, + and *R's type should not be char, bool, or an enumeration type. These macros work correctly on all known practical hosts, and do not rely on undefined behavior due to signed arithmetic overflow. @@ -635,8 +328,8 @@ These macros are tuned for B being a constant. */ -#define INT_ADD_OK(a, b, r) ! INT_ADD_WRAPV (a, b, r) -#define INT_SUBTRACT_OK(a, b, r) ! INT_SUBTRACT_WRAPV (a, b, r) -#define INT_MULTIPLY_OK(a, b, r) ! INT_MULTIPLY_WRAPV (a, b, r) +#define INT_ADD_OK(a, b, r) (! INT_ADD_WRAPV (a, b, r)) +#define INT_SUBTRACT_OK(a, b, r) (! INT_SUBTRACT_WRAPV (a, b, r)) +#define INT_MULTIPLY_OK(a, b, r) (! INT_MULTIPLY_WRAPV (a, b, r)) #endif /* _GL_INTPROPS_H */ diff --git a/lib/stdckdint.in.h b/lib/stdckdint.in.h new file mode 100644 index 00000000000..90fa62e5966 --- /dev/null +++ b/lib/stdckdint.in.h @@ -0,0 +1,37 @@ +/* stdckdint.h -- checked integer arithmetic + + Copyright 2022 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify it + under the terms of the GNU Lesser General Public License as published + by the Free Software Foundation; either version 2.1 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see <https://www.gnu.org/licenses/>. */ + +#ifndef _GL_STDCKDINT_H +#define _GL_STDCKDINT_H + +#include "intprops-internal.h" + +#include <stdbool.h> + +/* Store into *R the low-order bits of A + B, A - B, A * B, respectively. + Return 1 if the result overflows, 0 otherwise. + A, B, and *R can have any integer type other than char, bool, a + bit-precise integer type, or an enumeration type. + + These are like the standard macros introduced in C23, except that + arguments should not have side effects. */ + +#define ckd_add(r, a, b) ((bool) _GL_INT_ADD_WRAPV (a, b, r)) +#define ckd_sub(r, a, b) ((bool) _GL_INT_SUBTRACT_WRAPV (a, b, r)) +#define ckd_mul(r, a, b) ((bool) _GL_INT_MULTIPLY_WRAPV (a, b, r)) + +#endif /* _GL_STDCKDINT_H */ diff --git a/lib/tempname.c b/lib/tempname.c index 5fc5efe0314..11b4796b34b 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -20,16 +20,10 @@ # include "tempname.h" #endif -#include <sys/types.h> -#include <assert.h> #include <stdbool.h> - #include <errno.h> #include <stdio.h> -#ifndef P_tmpdir -# define P_tmpdir "/tmp" -#endif #ifndef TMP_MAX # define TMP_MAX 238328 #endif @@ -43,27 +37,23 @@ # error report this to bug-gnulib@gnu.org #endif -#include <stddef.h> #include <stdlib.h> #include <string.h> #include <fcntl.h> -#include <stdalign.h> #include <stdint.h> #include <sys/random.h> #include <sys/stat.h> #include <time.h> #if _LIBC -# define struct_stat64 struct stat64 -# define __secure_getenv __libc_secure_getenv +# define struct_stat64 struct __stat64_t64 #else # define struct_stat64 struct stat # define __gen_tempname gen_tempname # define __mkdir mkdir # define __open open -# define __lstat64(file, buf) lstat (file, buf) -# define __stat64(file, buf) stat (file, buf) +# define __lstat64_time64(file, buf) lstat (file, buf) # define __getrandom getrandom # define __clock_gettime64 clock_gettime # define __timespec64 timespec @@ -77,94 +67,56 @@ typedef uint_fast64_t random_value; #define BASE_62_DIGITS 10 /* 62**10 < UINT_FAST64_MAX */ #define BASE_62_POWER (62LL * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62) +/* Return the result of mixing the entropy from R and S. + Assume that R and S are not particularly random, + and that the result should look randomish to an untrained eye. */ + static random_value -random_bits (random_value var, bool use_getrandom) +mix_random_values (random_value r, random_value s) { - random_value r; - /* Without GRND_NONBLOCK it can be blocked for minutes on some systems. */ - if (use_getrandom && __getrandom (&r, sizeof r, GRND_NONBLOCK) == sizeof r) - return r; -#if _LIBC || (defined CLOCK_MONOTONIC && HAVE_CLOCK_GETTIME) - /* Add entropy if getrandom did not work. */ - struct __timespec64 tv; - __clock_gettime64 (CLOCK_MONOTONIC, &tv); - var ^= tv.tv_nsec; -#endif - return 2862933555777941757 * var + 3037000493; + /* As this code is used only when high-quality randomness is neither + available nor necessary, there is no need for fancier polynomials + such as those in the Linux kernel's 'random' driver. */ + return (2862933555777941757 * r + 3037000493) ^ s; } -#if _LIBC -/* Return nonzero if DIR is an existent directory. */ -static int -direxists (const char *dir) -{ - struct_stat64 buf; - return __stat64 (dir, &buf) == 0 && S_ISDIR (buf.st_mode); -} +/* Set *R to a random value. + Return true if *R is set to high-quality value taken from getrandom. + Otherwise return false, falling back to a low-quality *R that might + depend on S. -/* Path search algorithm, for tmpnam, tmpfile, etc. If DIR is - non-null and exists, uses it; otherwise uses the first of $TMPDIR, - P_tmpdir, /tmp that exists. Copies into TMPL a template suitable - for use with mk[s]temp. Will fail (-1) if DIR is non-null and - doesn't exist, none of the searched dirs exists, or there's not - enough space in TMPL. */ -int -__path_search (char *tmpl, size_t tmpl_len, const char *dir, const char *pfx, - int try_tmpdir) + This function returns false only when getrandom fails. + On GNU systems this should happen only early in the boot process, + when the fallback should be good enough for programs using tempname + because any attacker likely has root privileges already. */ + +static bool +random_bits (random_value *r, random_value s) { - const char *d; - size_t dlen, plen; + /* Without GRND_NONBLOCK it can be blocked for minutes on some systems. */ + if (__getrandom (r, sizeof *r, GRND_NONBLOCK) == sizeof *r) + return true; - if (!pfx || !pfx[0]) - { - pfx = "file"; - plen = 4; - } - else - { - plen = strlen (pfx); - if (plen > 5) - plen = 5; - } + /* If getrandom did not work, use ersatz entropy based on low-order + clock bits. On GNU systems getrandom should fail only + early in booting, when ersatz should be good enough. + Do not use ASLR-based entropy, as that would leak ASLR info into + the resulting file name which is typically public. - if (try_tmpdir) - { - d = __secure_getenv ("TMPDIR"); - if (d != NULL && direxists (d)) - dir = d; - else if (dir != NULL && direxists (dir)) - /* nothing */ ; - else - dir = NULL; - } - if (dir == NULL) - { - if (direxists (P_tmpdir)) - dir = P_tmpdir; - else if (strcmp (P_tmpdir, "/tmp") != 0 && direxists ("/tmp")) - dir = "/tmp"; - else - { - __set_errno (ENOENT); - return -1; - } - } + Of course we are in a state of sin here. */ - dlen = strlen (dir); - while (dlen > 1 && dir[dlen - 1] == '/') - dlen--; /* remove trailing slashes */ + random_value v = s; - /* check we have room for "${dir}/${pfx}XXXXXX\0" */ - if (tmpl_len < dlen + 1 + plen + 6 + 1) - { - __set_errno (EINVAL); - return -1; - } +#if _LIBC || (defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME) + struct __timespec64 tv; + __clock_gettime64 (CLOCK_REALTIME, &tv); + v = mix_random_values (v, tv.tv_sec); + v = mix_random_values (v, tv.tv_nsec); +#endif - sprintf (tmpl, "%.*s/%.*sXXXXXX", (int) dlen, dir, (int) plen, pfx); - return 0; + *r = mix_random_values (v, clock ()); + return false; } -#endif /* _LIBC */ #if _LIBC static int try_tempname_len (char *, int, void *, int (*) (char *, void *), @@ -191,7 +143,7 @@ try_nocreate (char *tmpl, _GL_UNUSED void *flags) { struct_stat64 st; - if (__lstat64 (tmpl, &st) == 0 || errno == EOVERFLOW) + if (__lstat64_time64 (tmpl, &st) == 0 || errno == EOVERFLOW) __set_errno (EEXIST); return errno == ENOENT ? 0 : -1; } @@ -213,7 +165,7 @@ static const char letters[] = and return a read-write fd. The file is mode 0600. __GT_DIR: create a directory, which will be mode 0700. - We use a clever algorithm to get hard-to-predict names. */ + */ #ifdef _LIBC static #endif @@ -261,25 +213,17 @@ try_tempname_len (char *tmpl, int suffixlen, void *args, unsigned int attempts = ATTEMPTS_MIN; #endif - /* A random variable. The initial value is used only the for fallback path - on 'random_bits' on 'getrandom' failure. Its initial value tries to use - some entropy from the ASLR and ignore possible bits from the stack - alignment. */ - random_value v = ((uintptr_t) &v) / alignof (max_align_t); + /* A random variable. */ + random_value v = 0; - /* How many random base-62 digits can currently be extracted from V. */ + /* A value derived from the random variable, and how many random + base-62 digits can currently be extracted from VDIGBUF. */ + random_value vdigbuf; int vdigits = 0; - /* Whether to consume entropy when acquiring random bits. On the - first try it's worth the entropy cost with __GT_NOCREATE, which - is inherently insecure and can use the entropy to make it a bit - less secure. On the (rare) second and later attempts it might - help against DoS attacks. */ - bool use_getrandom = tryfunc == try_nocreate; - - /* Least unfair value for V. If V is less than this, V can generate - BASE_62_DIGITS digits fairly. Otherwise it might be biased. */ - random_value const unfair_min + /* Least biased value for V. If V is less than this, V can generate + BASE_62_DIGITS unbiased digits. Otherwise the digits are biased. */ + random_value const biased_min = RANDOM_VALUE_MAX - RANDOM_VALUE_MAX % BASE_62_POWER; len = strlen (tmpl); @@ -299,18 +243,16 @@ try_tempname_len (char *tmpl, int suffixlen, void *args, { if (vdigits == 0) { - do - { - v = random_bits (v, use_getrandom); - use_getrandom = true; - } - while (unfair_min <= v); + /* Worry about bias only if the bits are high quality. */ + while (random_bits (&v, v) && biased_min <= v) + continue; + vdigbuf = v; vdigits = BASE_62_DIGITS; } - XXXXXX[i] = letters[v % 62]; - v /= 62; + XXXXXX[i] = letters[vdigbuf % 62]; + vdigbuf /= 62; vdigits--; } diff --git a/lib/tempname.h b/lib/tempname.h index c172820f7f5..5e3c5e15500 100644 --- a/lib/tempname.h +++ b/lib/tempname.h @@ -48,7 +48,7 @@ extern "C" { and return a read-write fd. The file is mode 0600. GT_DIR: create a directory, which will be mode 0700. - We use a clever algorithm to get hard-to-predict names. */ + */ extern int gen_tempname (char *tmpl, int suffixlen, int flags, int kind); /* Similar, except X_SUFFIX_LEN gives the number of Xs. */ extern int gen_tempname_len (char *tmpl, int suffixlen, int flags, int kind, diff --git a/lib/verify.h b/lib/verify.h index c5c63ae97c6..47b6ee661b3 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -303,13 +303,16 @@ template <int w> # define assume(R) ((R) ? (void) 0 : __builtin_unreachable ()) #elif 1200 <= _MSC_VER # define assume(R) __assume (R) +#elif 202311L <= __STDC_VERSION__ +# include <stddef.h> +# define assume(R) ((R) ? (void) 0 : unreachable ()) #elif (defined GCC_LINT || defined lint) && _GL_HAS_BUILTIN_TRAP /* Doing it this way helps various packages when configured with --enable-gcc-warnings, which compiles with -Dlint. It's nicer - when 'assume' silences warnings even with older GCCs. */ + if 'assume' silences warnings with GCC 3.4 through GCC 4.4.7 (2012). */ # define assume(R) ((R) ? (void) 0 : __builtin_trap ()) #else - /* Some tools grok NOTREACHED, e.g., Oracle Studio 12.6. */ + /* Some older tools grok NOTREACHED, e.g., Oracle Studio 12.6 (2017). */ # define assume(R) ((R) ? (void) 0 : /*NOTREACHED*/ (void) 0) #endif diff --git a/lisp/allout.el b/lisp/allout.el index 8e303a8a02f..fb922608b0d 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -4598,7 +4598,7 @@ by pops to non-distinctive yanks. Bug..." (save-match-data (save-excursion (let* ((text-start allout-recent-prefix-end) - (heading-end (point-at-eol))) + (heading-end (line-end-position))) (goto-char text-start) (setq file-name (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t) @@ -4874,7 +4874,7 @@ siblings, even if the target topic is already closed." (interactive) (save-excursion (allout-back-to-heading) - (if (allout-hidden-p (point-at-eol)) + (if (allout-hidden-p (line-end-position)) (allout-show-current-subtree) (allout-hide-current-subtree)))) ;;;_ > allout-show-current-branches () @@ -5537,7 +5537,7 @@ environment. Leaves point at the end of the line." (let ((inhibit-field-text-motion t)) (beginning-of-line) (let (;(beg (point)) - (end (point-at-eol))) + (end (line-end-position))) (save-match-data (while (re-search-forward "\\\\" ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" diff --git a/lisp/auth-source.el b/lisp/auth-source.el index f198362f106..c79e5b81f76 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -1618,10 +1618,13 @@ authentication tokens: (search-specs (auth-source-secrets-listify-pattern (apply #'append (mapcar (lambda (k) - (if (or (null (plist-get spec k)) - (eq t (plist-get spec k))) - nil - (list k (plist-get spec k)))) + (let ((v (plist-get spec k))) + (if (or (null v) + (eq t v)) + nil + (list + k + (auth-source-ensure-strings v))))) search-keys)))) ;; needed keys (always including host, login, port, and secret) (returned-keys (delete-dups (append diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 918c0c7f19d..872a896689c 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -800,7 +800,7 @@ This is an internal function used by Auto-Revert Mode." (when revert (when (and auto-revert-verbose (not (eq revert 'fast))) - (message "Reverting buffer `%s'." (buffer-name))) + (message "Reverting buffer `%s'" (buffer-name))) ;; If point (or a window point) is at the end of the buffer, we ;; want to keep it at the end after reverting. This allows one ;; to tail a file. diff --git a/lisp/battery.el b/lisp/battery.el index 93f4070e4bc..72b3dfdae7c 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -369,11 +369,11 @@ The following %-sequences are provided: (setq driver-version (match-string 1)) (setq bios-version (match-string 2)) (setq tem (string-to-number (match-string 3) 16)) - (if (not (logand tem 2)) + (if (zerop (logand tem 2)) (setq bios-interface "not supported") (setq bios-interface "enabled") - (cond ((logand tem 16) (setq bios-interface "disabled")) - ((logand tem 32) (setq bios-interface "disengaged"))) + (cond ((/= (logand tem 16) 0) (setq bios-interface "disabled")) + ((/= (logand tem 32) 0) (setq bios-interface "disengaged"))) (setq tem (string-to-number (match-string 4) 16)) (cond ((= tem 0) (setq line-status "off-line")) ((= tem 1) (setq line-status "on-line")) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index db2063f4eac..8dfc16bf9fa 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -202,12 +202,6 @@ If nil, don't display a mark on the fringe." :set #'fringe-custom-set-bitmap :version "29.1") -;; FIXME: No longer used. Should be declared obsolete or removed. -(defface bookmark-menu-heading - '((t (:inherit font-lock-type-face))) - "Face used to highlight the heading in bookmark menu buffers." - :version "22.1") - (defface bookmark-face '((((class grayscale) (background light)) @@ -501,7 +495,7 @@ In other words, return all information but the name." (defun bookmark--set-fringe-mark () "Apply a colorized overlay to the bookmarked location. See user option `bookmark-fringe-mark'." - (let ((bm (make-overlay (point-at-bol) (1+ (point-at-bol))))) + (let ((bm (make-overlay (pos-bol) (1+ (pos-bol))))) (overlay-put bm 'category 'bookmark) (overlay-put bm 'evaporate t) (overlay-put bm 'before-string @@ -524,7 +518,7 @@ See user option `bookmark-fringe-mark'." (setq overlays (save-excursion (goto-char pos) - (overlays-in (point-at-bol) (1+ (point-at-bol))))) + (overlays-in (pos-bol) (1+ (pos-bol))))) (while (and (not found) (setq temp (pop overlays))) (when (eq 'bookmark (overlay-get temp 'category)) (delete-overlay (setq found temp)))))))))) @@ -1020,7 +1014,7 @@ the list of bookmarks.)" "Kill from point to end of line. If optional arg NEWLINE-TOO is non-nil, delete the newline too. Does not affect the kill ring." - (let ((eol (line-end-position))) + (let ((eol (pos-eol))) (delete-region (point) eol) (when (and newline-too (= (following-char) ?\n)) (delete-char 1)))) @@ -1227,7 +1221,7 @@ and then show any annotations for this bookmark." ;; FIXME: we used to only run bookmark-after-jump-hook in ;; `bookmark-jump' itself, but in none of the other commands. (when bookmark-fringe-mark - (let ((overlays (overlays-in (point-at-bol) (1+ (point-at-bol)))) + (let ((overlays (overlays-in (pos-bol) (1+ (pos-bol)))) temp found) (while (and (not found) (setq temp (pop overlays))) (when (eq 'bookmark (overlay-get temp 'category)) diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el index 6144ee1c08b..3db3746a8e5 100644 --- a/lisp/calc/calc-keypd.el +++ b/lisp/calc/calc-keypd.el @@ -387,7 +387,7 @@ (interactive) (unless (eq major-mode 'calc-keypad-mode) (error "Must be in *Calc Keypad* buffer for this command")) - (let* ((row (count-lines (point-min) (point-at-bol))) + (let* ((row (count-lines (point-min) (line-beginning-position))) (y (/ row 2)) (x (/ (current-column) (if (>= y 4) 6 5))) radix frac inv diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index f11d9741ec7..127f6340a1e 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1447,7 +1447,8 @@ Redefine the corresponding command." (let ((calc-kbd-push-level 0)) (execute-kbd-macro (substring body 0 -2)))) (let ((calc-kbd-push-level (1+ calc-kbd-push-level))) - (message "%s" "Saving modes; type Z' to restore") + ;; Avoid substituting the "'" character: + (message "%s" "Saving modes; type Z' to restore") (recursive-edit)))))) (defun calc-kbd-pop () diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 71cc68b0c20..504ba5b40d1 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -48,7 +48,7 @@ (let ((stuff (calc-top-list n (- num n -1)))) (calc-cursor-stack-index num) (unless calc-kill-line-numbering - (re-search-forward "\\=[0-9]+:\\s-+" (point-at-eol) t)) + (re-search-forward "\\=[0-9]+:\\s-+" (line-end-position) t)) (let ((first (point))) (calc-cursor-stack-index (- num n)) (if (null nn) @@ -150,7 +150,6 @@ ;; This function uses calc-last-kill if possible to get an exact result, ;; otherwise it just parses the yanked string. -;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96 ;;;###autoload (defun calc-yank-internal (radix thing-raw) "Internal common implementation for yank functions. @@ -411,8 +410,8 @@ Interactively, reads the register using `register-read-with-preview'." (setq single t) (setq arg (prefix-numeric-value arg)) (if (= arg 0) - (setq top (point-at-bol) - bot (point-at-eol)) + (setq top (line-beginning-position) + bot (line-end-position)) (save-excursion (setq top (point)) (forward-line arg) diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index 6a147bf430c..a2d8bae36b4 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -133,7 +133,7 @@ DIR defaults to `default-directory'." (goto-char (point-min)) (when (not (eobp)) (file-name-as-directory - (buffer-substring (point) (point-at-eol))))))) + (buffer-substring (point) (line-end-position))))))) (defun cedet-gnu-global-version-check (&optional noerror) "Check the version of the installed GNU Global command. diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index e7635c0aec5..605dc9fa19c 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -902,14 +902,14 @@ If PARENT is non-nil, it is somehow related as a parent to thing." (interactive) (forward-line 1) (beginning-of-line) - (skip-chars-forward "- *><[]" (point-at-eol))) + (skip-chars-forward "- *><[]" (line-end-position))) (defun data-debug-prev () "Go to the previous line in the Ddebug buffer." (interactive) (forward-line -1) (beginning-of-line) - (skip-chars-forward "- *><[]" (point-at-eol))) + (skip-chars-forward "- *><[]" (line-end-position))) (defun data-debug-next-expando () "Go to the next line in the Ddebug buffer. @@ -996,7 +996,7 @@ Do nothing if already contracted." (data-debug-current-line-expanded-p)) (data-debug-contract-current-line) (data-debug-expand-current-line)) - (skip-chars-forward "- *><[]" (point-at-eol))) + (skip-chars-forward "- *><[]" (line-end-position))) (defun data-debug-expand-or-contract-mouse (event) "Expand or contract anything at event EVENT." diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el index faf50edaa13..78edea1da8d 100644 --- a/lisp/cedet/ede/autoconf-edit.el +++ b/lisp/cedet/ede/autoconf-edit.el @@ -383,16 +383,16 @@ Optional argument BODY is the code to execute which edits the autoconf file." (beginning-of-line) (let* ((end-of-cmd (save-excursion - (if (re-search-forward "(" (point-at-eol) t) + (if (re-search-forward "(" (line-end-position) t) (progn (forward-char -1) (forward-sexp 1) (point)) ;; Else, just return EOL. - (point-at-eol)))) + (line-end-position)))) (cnt 0)) (save-restriction - (narrow-to-region (point-at-bol) end-of-cmd) + (narrow-to-region (line-beginning-position) end-of-cmd) (condition-case nil (progn (down-list 1) @@ -417,7 +417,7 @@ INDEX starts at 1." (down-list 1) (re-search-forward ", ?" nil nil (1- index)) (let ((end (save-excursion - (re-search-forward ",\\|)" (point-at-eol)) + (re-search-forward ",\\|)" (line-end-position)) (forward-char -1) (point)))) (setq autoconf-deleted-text (buffer-substring (point) end)) diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el index 9a913109f09..7739115b31f 100644 --- a/lisp/cedet/ede/pmake.el +++ b/lisp/cedet/ede/pmake.el @@ -566,7 +566,7 @@ Argument THIS is the target that should insert stuff." (cond ((eq (cdr sv) 'share) ;; This variable may be shared between multiple targets. (if (re-search-backward (concat "\\$(" (car sv) ")") - (point-at-bol) t) + (line-beginning-position) t) ;; If its already in the dist target, then skip it. nil (setq sv (car sv)))) diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 7c56ca19936..594d8f1c29d 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -272,7 +272,8 @@ is found, such as a `-version' variable, or the standard header." (let ((path (match-string 1))) (if (string= path "nil") nil - (delete-region (point-at-bol) (point-at-bol 2))))))))) + (delete-region (line-beginning-position) + (line-beginning-position 2))))))))) ;;; ;; Autoload generators diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index 544e39b8729..de6936ad1a8 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -911,7 +911,7 @@ Kill the Configure buffer if it was not already in a buffer." (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote var) "\\s-*=\\s-*") nil t) - (buffer-substring-no-properties (point) (point-at-eol))))) + (buffer-substring-no-properties (point) (line-end-position))))) (defun project-am-extract-package-info (dir) "Extract the package information for directory DIR." diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el index 604b660344c..f45c070539a 100644 --- a/lisp/cedet/ede/speedbar.el +++ b/lisp/cedet/ede/speedbar.el @@ -175,7 +175,7 @@ Argument DIR is the directory from which to derive the list of objects." (beginning-of-line) (looking-at "^\\([0-9]+\\):") (let ((depth (string-to-number (match-string 1)))) - (while (not (re-search-forward "[]] [^ ]" (point-at-eol) t)) + (while (not (re-search-forward "[]] [^ ]" (line-end-position) t)) (re-search-backward (format "^%d:" (1- depth))) (setq depth (1- depth))) (speedbar-line-token)))) diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index f7af10887c9..9941f2a0cb7 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -202,7 +202,7 @@ If POINT is nil or missing, the current point is used instead. Optional argument FACE specifies the face to do the highlighting." (save-excursion (goto-char (or point (point))) - (let ((start (point-at-bol)) + (let ((start (line-beginning-position)) (end (save-excursion (end-of-line) (when (not (eobp)) diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index ee1cbcad4da..d4ce20589e6 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -437,8 +437,8 @@ I think it just returns t/nil dependent on if VAR has been defined." (progn (semantic-push-parser-warning (format "Skip %s" (buffer-substring-no-properties - (point-at-bol) (point-at-eol))) - (point-at-bol) (point-at-eol)) + (line-beginning-position) (line-end-position))) + (line-beginning-position) (line-end-position)) nil) t))) @@ -501,8 +501,10 @@ code to parse." ;; The if indicates to skip this preprocessor section (let () ;; (pt nil) - (semantic-push-parser-warning (format "Skip %s" (buffer-substring-no-properties (point-at-bol) (point-at-eol))) - (point-at-bol) (point-at-eol)) + (semantic-push-parser-warning (format "Skip %s" (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))) + (line-beginning-position) (line-end-position)) (beginning-of-line) ;; (setq pt (point)) ;; This skips only a section of a conditional. Once that section diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 97456265ead..d42022e0423 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -252,7 +252,7 @@ That is tag names plus names defined in tag attribute `:rest'." (skip-chars-backward "\r\n\t") ;; If a grammar footer is found, skip it. (re-search-backward "^;;;\\s-+\\S-+\\s-+ends here" - (point-at-bol) t) + (line-beginning-position) t) (skip-chars-backward "\r\n\t") (point))) "\n")) diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 1afb1d841dd..2d6f26919d7 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -818,13 +818,13 @@ visible, then highlight it." (goto-char (overlay-start region)) (when (pos-visible-in-window-p (point) (get-buffer-window (current-buffer) 'visible)) - (if (< (overlay-end region) (point-at-eol)) + (if (< (overlay-end region) (line-end-position)) (pulse-momentary-highlight-overlay region semantic-idle-symbol-highlight-face) ;; Not the same (pulse-momentary-highlight-region (overlay-start region) - (point-at-eol) + (line-end-position) semantic-idle-symbol-highlight-face)))) )) ((vectorp region) @@ -843,8 +843,8 @@ visible, then highlight it." end t) ;; This is likely it, give it a try. (pulse-momentary-highlight-region - start (if (<= end (point-at-eol)) end - (point-at-eol)) + start (if (<= end (line-end-position)) end + (line-end-position)) semantic-idle-symbol-highlight-face))) )))) nil)) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 4bdaaf77acf..b66e5c19cb2 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -826,7 +826,7 @@ Argument BEG and END specify the bounds of SYM in the buffer." (goto-char end) (setq arg-parsed (semantic-lex-spp-one-token-and-move-for-macro - ;; NOTE: This used to be (point-at-eol), but + ;; NOTE: This used to be (line-end-position), but ;; that was too close for multi-line arguments ;; to a macro. Point max may be too far if there ;; is a typo in the buffer. diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 9c64cc9f7e5..75c4ee328d6 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -1423,7 +1423,7 @@ Return either a paren token or a semantic list token depending on ;; to work properly. Lets try and move over ;; whatever white space we matched to begin ;; with. - (skip-syntax-forward "-.'" (point-at-eol)) + (skip-syntax-forward "-.'" (line-end-position)) ;; We may need to back up so newlines or whitespace is generated. (if (bolp) (backward-char 1))) diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index e48cefa4ca6..16bbacc428e 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -555,7 +555,7 @@ deleting the buffers that were opened." (when (re-search-forward (if (memq searchtype '(regexp tagregexp)) searchtxt (regexp-quote searchtxt)) - (point-at-eol) + (line-end-position) t) (goto-char (match-beginning 0)) ) diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index 7823dad6ef9..eacbb6f1f8e 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -234,7 +234,7 @@ Some useful functions are found in `semantic-format-tag-functions'." "Toggle showing the contents below the current line." (interactive) (beginning-of-line) - (when (re-search-forward "\\[[-+]\\]" (point-at-eol) t) + (when (re-search-forward "\\[[-+]\\]" (line-end-position) t) (forward-char -1) (push-button))) @@ -255,7 +255,7 @@ BUTTON is the button that was clicked." (forward-line (1- H)) (beginning-of-line) (back-to-indentation) - (setq text (cons (buffer-substring (point) (point-at-eol)) text))) + (setq text (cons (buffer-substring (point) (line-end-position)) text))) (setq text (nreverse text))) (goto-char (button-start button)) (forward-char 1) @@ -409,7 +409,7 @@ cursor to the beginning of that symbol, then record a macro as if (switch-to-buffer-other-window (semantic-tag-buffer tag)) (goto-char (point-min)) (forward-line (1- line)) - (when (not (re-search-forward (regexp-quote oldsym) (point-at-eol) t)) + (when (not (re-search-forward (regexp-quote oldsym) (line-end-position) t)) (error "Cannot find hit. Cannot record macro")) (goto-char (match-beginning 0)) ;; Cursor is now in the right location. Start recording a macro. @@ -479,7 +479,7 @@ Return the number of occurrences FUNCTION was operated upon." (goto-char (point-min)) (forward-line (1- line)) (beginning-of-line) - (while (re-search-forward (regexp-quote oldsym) (point-at-eol) t) + (while (re-search-forward (regexp-quote oldsym) (line-end-position) t) (setq count (1+ count)) (save-excursion ;; Leave cursor after the matched name. (goto-char (match-beginning 0)) ;; Go to beginning of that sym diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index fdd93c6bcf8..33fed9191e1 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -750,7 +750,7 @@ If there is no function, disable the header line." (if noshow "" (if semantic-stickyfunc-show-only-functions-p "" - (buffer-substring (point-at-bol) (point-at-eol)) + (buffer-substring (line-beginning-position) (line-end-position)) )) ;; Go get the first line of this tag. (goto-char (semantic-tag-start tag)) @@ -765,7 +765,7 @@ If there is no function, disable the header line." ;; Without going to the tag-name we would get"void" in the ;; header line which is IMHO not really useful (search-forward (semantic-tag-name tag) nil t) - (buffer-substring (point-at-bol) (point-at-eol)) + (buffer-substring (line-beginning-position) (line-end-position)) )))) (start 0)) (while (string-match "%" str start) @@ -959,7 +959,7 @@ function was called, move the overlay." (goto-char (semantic-tag-start tag)) (search-forward (semantic-tag-name tag) nil t) (overlay-put ol 'tag tag) - (move-overlay ol (point-at-bol) (point-at-eol))))))) + (move-overlay ol (line-beginning-position) (line-end-position))))))) nil) (semantic-add-minor-mode 'semantic-highlight-func-mode diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el index cc7ae1b181e..492f574fce6 100644 --- a/lisp/cedet/semantic/wisent/javascript.el +++ b/lisp/cedet/semantic/wisent/javascript.el @@ -107,7 +107,7 @@ This is currently needed for the mozrepl omniscient database." (when (looking-at "\\w\\|\\s_") (forward-sexp 1)) (setq end (point)) - (unless (re-search-backward "\\s-" (point-at-bol) t) + (unless (re-search-backward "\\s-" (line-beginning-position) t) (beginning-of-line)) (setq tmp (buffer-substring-no-properties (point) end)) ;; (setq symlist diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el index 8c5f343e98c..a25d1441f1f 100644 --- a/lisp/cedet/srecode/document.el +++ b/lisp/cedet/srecode/document.el @@ -496,7 +496,7 @@ It is assumed that the comment occurs just after VAR-IN." ;; Find any existing doc strings. (goto-char (semantic-tag-end var-in)) - (skip-syntax-forward "-" (point-at-eol)) + (skip-syntax-forward "-" (line-end-position)) (let ((lextok (semantic-doc-snarf-comment-for-tag 'lex)) ) @@ -521,7 +521,7 @@ It is assumed that the comment occurs just after VAR-IN." (end-of-line) (delete-horizontal-space) (move-to-column comment-column t) - (when (< (point) (point-at-eol)) (end-of-line)) + (when (< (point) (line-end-position)) (end-of-line)) ;; Perform the insertion (let ((srecode-semantic-selected-tag var-in) @@ -819,7 +819,7 @@ not account for verb parts." "Does TAG fit on one line with space on the end?" (save-excursion (semantic-go-to-tag tag) - (and (<= (semantic-tag-end tag) (point-at-eol)) + (and (<= (semantic-tag-end tag) (line-end-position)) (goto-char (semantic-tag-end tag)) (< (current-column) 70)))) diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index c0260c62a91..db17b7f23f8 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -406,7 +406,7 @@ Specify the :blank argument to enable this inserter.") ((eq (oref sti where) 'end) ;; If there is whitespace after pnt, then clear it out. (when (looking-at "\\s-*$") - (delete-region (point) (point-at-eol))) + (delete-region (point) (line-end-position))) (when (not (eolp)) (princ "\n"))) ) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index d5bae8f66f8..d3768766be0 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4291,6 +4291,9 @@ restoring it to the state of a face that has never been customized." (defvar widget-fringe-bitmap-prompt-value-history nil "History of input to `widget-fringe-bitmap-prompt-value'.") +;; In no-X builds, fringe.el isn't preloaded. +(autoload 'fringe-bitmap-p "fringe") + (define-widget 'fringe-bitmap 'symbol "A Lisp fringe bitmap name." :format "%v" diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 7ff3e333515..06f0b86fc43 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -780,20 +780,16 @@ which is replaced by the value returned by `dired-mark-prompt', with ARG and FILES as its arguments. FILES should be a list of file names. The result is used as the prompt. -This normally reads using `read-shell-command', but if the -`dired-x' package is loaded, use `dired-guess-shell-command' to -offer a smarter default choice of shell command." +Use `dired-guess-shell-command' to offer a smarter default choice +of shell command." (minibuffer-with-setup-hook (lambda () (setq-local dired-aux-files files) (setq-local minibuffer-default-add-function #'dired-minibuffer-default-add-shell-commands)) (setq prompt (format prompt (dired-mark-prompt arg files))) - (if (functionp 'dired-guess-shell-command) - (dired-mark-pop-up nil 'shell files - 'dired-guess-shell-command prompt files) - (dired-mark-pop-up nil 'shell files - 'read-shell-command prompt nil nil)))) + (dired-mark-pop-up nil 'shell files + 'dired-guess-shell-command prompt files))) ;;;###autoload (defcustom dired-confirm-shell-command t @@ -882,7 +878,7 @@ In a noninteractive call (from Lisp code), you must specify the list of file names explicitly with the FILE-LIST argument, which can be produced by `dired-get-marked-files', for example. -If `dired-x' is loaded, `dired-guess-shell-alist-default' and +`dired-guess-shell-alist-default' and `dired-guess-shell-alist-user' are consulted when the user is prompted for the shell command to use interactively. @@ -1071,6 +1067,265 @@ Return the result of `process-file' - zero for success." res))))) +;;; Guess shell command + +;; * `dired-guess-shell-command' provides smarter defaults for +;; `dired-read-shell-command'. +;; +;; * `dired-guess-shell-command' calls `dired-guess-default' with list of +;; marked files. +;; +;; * Parse `dired-guess-shell-alist-user' and +;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP +;; that matches the first file in the file list. +;; +;; * If the REGEXP matches all the entries of the file list then evaluate +;; COMMAND, which is either a string or a Lisp expression returning a +;; string. COMMAND may be a list of commands. +;; +;; * Return this command to `dired-guess-shell-command' which prompts user +;; with it. The list of commands is put into the list of default values. +;; If a command is used successfully then it is stored permanently in +;; `dired-shell-command-history'. + +;; Guess what shell command to apply to a file. +(defvar dired-shell-command-history nil + "History list for commands that read dired-shell commands.") + +;; Default list of shell commands. + +;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not +;; install GNU zip's version of zcat. + +(autoload 'Man-support-local-filenames "man") +(autoload 'vc-responsible-backend "vc") + +(defvar dired-guess-shell-alist-default + (list + (list "\\.tar\\'" + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " xvf") + "tar xvf") + ;; Extract files into a separate subdirectory + '(if dired-guess-shell-gnutar + (concat "mkdir " (file-name-sans-extension file) + "; " dired-guess-shell-gnutar " -C " + (file-name-sans-extension file) " -xvf") + (concat "mkdir " (file-name-sans-extension file) + "; tar -C " (file-name-sans-extension file) " -xvf")) + ;; List archive contents. + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " tvf") + "tar tvf")) + + ;; REGEXPS for compressed archives must come before the .Z rule to + ;; be recognized: + (list "\\.tar\\.Z\\'" + ;; Untar it. + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " zxvf") + (concat "zcat * | tar xvf -")) + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + + ;; gzip'ed archives + (list "\\.t\\(ar\\.\\)?gz\\'" + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " zxvf") + (concat "gunzip -qc * | tar xvf -")) + ;; Extract files into a separate subdirectory + '(if dired-guess-shell-gnutar + (concat "mkdir " (file-name-sans-extension file) + "; " dired-guess-shell-gnutar " -C " + (file-name-sans-extension file) " -zxvf") + (concat "mkdir " (file-name-sans-extension file) + "; gunzip -qc * | tar -C " + (file-name-sans-extension file) " -xvf -")) + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q" "")) + ;; List archive contents. + '(if dired-guess-shell-gnutar + (concat dired-guess-shell-gnutar " ztvf") + (concat "gunzip -qc * | tar tvf -"))) + + ;; bzip2'ed archives + (list "\\.t\\(ar\\.bz2\\|bz\\)\\'" + "bunzip2 -c * | tar xvf -" + ;; Extract files into a separate subdirectory + '(concat "mkdir " (file-name-sans-extension file) + "; bunzip2 -c * | tar -C " + (file-name-sans-extension file) " -xvf -") + ;; Optional decompression. + "bunzip2") + + ;; xz'ed archives + (list "\\.t\\(ar\\.\\)?xz\\'" + "unxz -c * | tar xvf -" + ;; Extract files into a separate subdirectory + '(concat "mkdir " (file-name-sans-extension file) + "; unxz -c * | tar -C " + (file-name-sans-extension file) " -xvf -") + ;; Optional decompression. + "unxz") + + '("\\.shar\\.Z\\'" "zcat * | unshar") + '("\\.shar\\.g?z\\'" "gunzip -qc * | unshar") + + '("\\.e?ps\\'" "ghostview" "xloadimage" "lpr") + (list "\\.e?ps\\.g?z\\'" "gunzip -qc * | ghostview -" + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.e?ps\\.Z\\'" "zcat * | ghostview -" + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + + (list "\\.patch\\'" + '(if (eq (ignore-errors (vc-responsible-backend default-directory)) 'Git) + "cat * | git apply" + "cat * | patch")) + (list "\\.patch\\.g?z\\'" "gunzip -qc * | patch" + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.patch\\.Z\\'" "zcat * | patch" + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + + ;; The following four extensions are useful with dired-man ("N" key) + ;; FIXME "man ./" does not work with dired-do-shell-command, + ;; because there seems to be no way for us to modify the filename, + ;; only the command. Hmph. `dired-man' works though. + (list "\\.\\(?:[0-9]\\|man\\)\\'" + '(let ((loc (Man-support-local-filenames))) + (cond ((eq loc 'man-db) "man -l") + ((eq loc 'man) "man ./") + (t + "cat * | tbl | nroff -man -h | col -b")))) + (list "\\.\\(?:[0-9]\\|man\\)\\.g?z\\'" + '(let ((loc (Man-support-local-filenames))) + (cond ((eq loc 'man-db) + "man -l") + ((eq loc 'man) + "man ./") + (t "gunzip -qc * | tbl | nroff -man -h | col -b"))) + ;; Optional decompression. + '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.[0-9]\\.Z\\'" + '(let ((loc (Man-support-local-filenames))) + (cond ((eq loc 'man-db) "man -l") + ((eq loc 'man) "man ./") + (t "zcat * | tbl | nroff -man -h | col -b"))) + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + '("\\.pod\\'" "perldoc" "pod2man * | nroff -man") + + '("\\.dvi\\'" "xdvi" "dvips") ; preview and printing + '("\\.au\\'" "play") ; play Sun audiofiles + '("\\.mpe?g\\'\\|\\.avi\\'" "xine -p") + '("\\.ogg\\'" "ogg123") + '("\\.mp3\\'" "mpg123") + '("\\.wav\\'" "play") + '("\\.uu\\'" "uudecode") ; for uudecoded files + '("\\.hqx\\'" "mcvert") + '("\\.sh\\'" "sh") ; execute shell scripts + '("\\.xbm\\'" "bitmap") ; view X11 bitmaps + '("\\.gp\\'" "gnuplot") + '("\\.p[bgpn]m\\'" "xloadimage") + '("\\.gif\\'" "xloadimage") ; view gif pictures + '("\\.tif\\'" "xloadimage") + '("\\.png\\'" "display") ; xloadimage 4.1 doesn't grok PNG + '("\\.jpe?g\\'" "xloadimage") + '("\\.fig\\'" "xfig") ; edit fig pictures + '("\\.out\\'" "xgraph") ; for plotting purposes. + '("\\.tex\\'" "latex" "tex") + '("\\.texi\\(nfo\\)?\\'" "makeinfo" "texi2dvi") + '("\\.pdf\\'" "xpdf") + '("\\.doc\\'" "antiword" "strings") + '("\\.rpm\\'" "rpm -qilp" "rpm -ivh") + '("\\.dia\\'" "dia") + '("\\.mgp\\'" "mgp") + + ;; Some other popular archivers. + (list "\\.zip\\'" "unzip" "unzip -l" + ;; Extract files into a separate subdirectory + '(concat "unzip" (if dired-guess-shell-gzip-quiet " -q") + " -d " (file-name-sans-extension file))) + '("\\.zoo\\'" "zoo x//") + '("\\.lzh\\'" "lharc x") + '("\\.arc\\'" "arc x") + '("\\.shar\\'" "unshar") + '("\\.rar\\'" "unrar x") + '("\\.7z\\'" "7z x") + + ;; Compression. + (list "\\.g?z\\'" '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) + (list "\\.dz\\'" "dictunzip") + (list "\\.bz2\\'" "bunzip2") + (list "\\.xz\\'" "unxz") + (list "\\.Z\\'" "uncompress" + ;; Optional conversion to gzip format. + '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") + " " dired-guess-shell-znew-switches)) + + '("\\.sign?\\'" "gpg --verify")) + "Default alist used for shell command guessing. +See `dired-guess-shell-alist-user'.") + +(defun dired-guess-default (files) + "Return a shell command, or a list of commands, appropriate for FILES. +See `dired-guess-shell-alist-user'." + (let* ((case-fold-search dired-guess-shell-case-fold-search) + (programs + (delete-dups + (mapcar + (lambda (command) + (eval command `((file . ,(car files))))) + (seq-reduce + #'append + (mapcar #'cdr + (seq-filter (lambda (elem) + (seq-every-p + (lambda (file) + (string-match-p (car elem) file)) + files)) + (append dired-guess-shell-alist-user + dired-guess-shell-alist-default))) + nil))))) + (if (length= programs 1) + (car programs) + programs))) + +;;;###autoload +(defun dired-guess-shell-command (prompt files) + "Ask user with PROMPT for a shell command, guessing a default from FILES." + (let ((default (dired-guess-default files)) + default-list val) + (if (null default) + ;; Nothing to guess + (read-shell-command prompt nil 'dired-shell-command-history) + (setq prompt (replace-regexp-in-string ": $" " " prompt)) + (if (listp default) + ;; More than one guess + (setq default-list default + default (car default) + prompt (concat + prompt + (format "{%d guesses} " (length default-list)))) + ;; Just one guess + (setq default-list (list default))) + ;; Put the first guess in the prompt but not in the initial value. + (setq prompt (concat prompt (format "[%s]: " default))) + ;; All guesses can be retrieved with M-n + (setq val (read-shell-command prompt nil + 'dired-shell-command-history + default-list)) + ;; If we got a return, then return default. + (if (equal val "") default val)))) + + ;;; Commands that delete or redisplay part of the dired buffer (defun dired-kill-line (&optional arg) @@ -3289,7 +3544,8 @@ Intended to be added to `isearch-mode-hook'." The returned function narrows the search to match the search string only as part of a file name enclosed by the text property `dired-filename'. It's intended to override the default search function." - (isearch-search-fun-in-text-property (funcall orig-fun) 'dired-filename)) + (isearch-search-fun-in-text-property + (funcall orig-fun) '(dired-filename dired-symlink-filename))) ;;;###autoload (defun dired-isearch-filenames () diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 9edf8374815..cf1ef37694f 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -196,35 +196,6 @@ toggle between those two." :type 'boolean :group 'dired-x) -(defcustom dired-guess-shell-gnutar - (catch 'found - (dolist (exe '("tar" "gtar")) - (if (with-temp-buffer - (ignore-errors (call-process exe nil t nil "--version")) - (and (re-search-backward "GNU tar" nil t) t)) - (throw 'found exe)))) - "If non-nil, name of GNU tar executable. -\(E.g., \"tar\" or \"gtar\"). The `z' switch will be used with it for -compressed or gzip'ed tar files. If you don't have GNU tar, set this -to nil: a pipe using `zcat' or `gunzip -c' will be used." - ;; Changed from system-type test to testing --version output. - ;; Maybe test --help for -z instead? - :version "24.1" - :type '(choice (const :tag "Not GNU tar" nil) - (string :tag "Command name")) - :group 'dired-x) - -(defcustom dired-guess-shell-gzip-quiet t - "Non-nil says pass -q to gzip overriding verbose GZIP environment." - :type 'boolean - :group 'dired-x) - -(defcustom dired-guess-shell-znew-switches nil - "If non-nil, then string of switches passed to `znew', example: \"-K\"." - :type '(choice (const :tag "None" nil) - (string :tag "Switches")) - :group 'dired-x) - ;;; Key bindings @@ -727,302 +698,6 @@ Also useful for `auto-mode-alist' like this: (shell-command command output-buffer error-buffer))) -;;; Guess shell command - -;; Brief Description: -;; -;; * `dired-do-shell-command' is bound to `!' by dired.el. -;; -;; * `dired-guess-shell-command' provides smarter defaults for -;; dired-aux.el's `dired-read-shell-command'. -;; -;; * `dired-guess-shell-command' calls `dired-guess-default' with list of -;; marked files. -;; -;; * Parse `dired-guess-shell-alist-user' and -;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP -;; that matches the first file in the file list. -;; -;; * If the REGEXP matches all the entries of the file list then evaluate -;; COMMAND, which is either a string or a Lisp expression returning a -;; string. COMMAND may be a list of commands. -;; -;; * Return this command to `dired-guess-shell-command' which prompts user -;; with it. The list of commands is put into the list of default values. -;; If a command is used successfully then it is stored permanently in -;; `dired-shell-command-history'. - -;; Guess what shell command to apply to a file. -(defvar dired-shell-command-history nil - "History list for commands that read dired-shell commands.") - -;; Default list of shell commands. - -;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not -;; install GNU zip's version of zcat. - -(autoload 'Man-support-local-filenames "man") -(autoload 'vc-responsible-backend "vc") - -(defvar dired-guess-shell-alist-default - (list - (list "\\.tar\\'" - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " xvf") - "tar xvf") - ;; Extract files into a separate subdirectory - '(if dired-guess-shell-gnutar - (concat "mkdir " (file-name-sans-extension file) - "; " dired-guess-shell-gnutar " -C " - (file-name-sans-extension file) " -xvf") - (concat "mkdir " (file-name-sans-extension file) - "; tar -C " (file-name-sans-extension file) " -xvf")) - ;; List archive contents. - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " tvf") - "tar tvf")) - - ;; REGEXPS for compressed archives must come before the .Z rule to - ;; be recognized: - (list "\\.tar\\.Z\\'" - ;; Untar it. - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " zxvf") - (concat "zcat * | tar xvf -")) - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - - ;; gzip'ed archives - (list "\\.t\\(ar\\.\\)?gz\\'" - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " zxvf") - (concat "gunzip -qc * | tar xvf -")) - ;; Extract files into a separate subdirectory - '(if dired-guess-shell-gnutar - (concat "mkdir " (file-name-sans-extension file) - "; " dired-guess-shell-gnutar " -C " - (file-name-sans-extension file) " -zxvf") - (concat "mkdir " (file-name-sans-extension file) - "; gunzip -qc * | tar -C " - (file-name-sans-extension file) " -xvf -")) - ;; Optional decompression. - '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q" "")) - ;; List archive contents. - '(if dired-guess-shell-gnutar - (concat dired-guess-shell-gnutar " ztvf") - (concat "gunzip -qc * | tar tvf -"))) - - ;; bzip2'ed archives - (list "\\.t\\(ar\\.bz2\\|bz\\)\\'" - "bunzip2 -c * | tar xvf -" - ;; Extract files into a separate subdirectory - '(concat "mkdir " (file-name-sans-extension file) - "; bunzip2 -c * | tar -C " - (file-name-sans-extension file) " -xvf -") - ;; Optional decompression. - "bunzip2") - - ;; xz'ed archives - (list "\\.t\\(ar\\.\\)?xz\\'" - "unxz -c * | tar xvf -" - ;; Extract files into a separate subdirectory - '(concat "mkdir " (file-name-sans-extension file) - "; unxz -c * | tar -C " - (file-name-sans-extension file) " -xvf -") - ;; Optional decompression. - "unxz") - - '("\\.shar\\.Z\\'" "zcat * | unshar") - '("\\.shar\\.g?z\\'" "gunzip -qc * | unshar") - - '("\\.e?ps\\'" "ghostview" "xloadimage" "lpr") - (list "\\.e?ps\\.g?z\\'" "gunzip -qc * | ghostview -" - ;; Optional decompression. - '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) - (list "\\.e?ps\\.Z\\'" "zcat * | ghostview -" - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - - (list "\\.patch\\'" - '(if (eq (ignore-errors (vc-responsible-backend default-directory)) 'Git) - "cat * | git apply" - "cat * | patch")) - (list "\\.patch\\.g?z\\'" "gunzip -qc * | patch" - ;; Optional decompression. - '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) - (list "\\.patch\\.Z\\'" "zcat * | patch" - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - - ;; The following four extensions are useful with dired-man ("N" key) - ;; FIXME "man ./" does not work with dired-do-shell-command, - ;; because there seems to be no way for us to modify the filename, - ;; only the command. Hmph. `dired-man' works though. - (list "\\.\\(?:[0-9]\\|man\\)\\'" - '(let ((loc (Man-support-local-filenames))) - (cond ((eq loc 'man-db) "man -l") - ((eq loc 'man) "man ./") - (t - "cat * | tbl | nroff -man -h | col -b")))) - (list "\\.\\(?:[0-9]\\|man\\)\\.g?z\\'" - '(let ((loc (Man-support-local-filenames))) - (cond ((eq loc 'man-db) - "man -l") - ((eq loc 'man) - "man ./") - (t "gunzip -qc * | tbl | nroff -man -h | col -b"))) - ;; Optional decompression. - '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) - (list "\\.[0-9]\\.Z\\'" - '(let ((loc (Man-support-local-filenames))) - (cond ((eq loc 'man-db) "man -l") - ((eq loc 'man) "man ./") - (t "zcat * | tbl | nroff -man -h | col -b"))) - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - '("\\.pod\\'" "perldoc" "pod2man * | nroff -man") - - '("\\.dvi\\'" "xdvi" "dvips") ; preview and printing - '("\\.au\\'" "play") ; play Sun audiofiles - '("\\.mpe?g\\'\\|\\.avi\\'" "xine -p") - '("\\.ogg\\'" "ogg123") - '("\\.mp3\\'" "mpg123") - '("\\.wav\\'" "play") - '("\\.uu\\'" "uudecode") ; for uudecoded files - '("\\.hqx\\'" "mcvert") - '("\\.sh\\'" "sh") ; execute shell scripts - '("\\.xbm\\'" "bitmap") ; view X11 bitmaps - '("\\.gp\\'" "gnuplot") - '("\\.p[bgpn]m\\'" "xloadimage") - '("\\.gif\\'" "xloadimage") ; view gif pictures - '("\\.tif\\'" "xloadimage") - '("\\.png\\'" "display") ; xloadimage 4.1 doesn't grok PNG - '("\\.jpe?g\\'" "xloadimage") - '("\\.fig\\'" "xfig") ; edit fig pictures - '("\\.out\\'" "xgraph") ; for plotting purposes. - '("\\.tex\\'" "latex" "tex") - '("\\.texi\\(nfo\\)?\\'" "makeinfo" "texi2dvi") - '("\\.pdf\\'" "xpdf") - '("\\.doc\\'" "antiword" "strings") - '("\\.rpm\\'" "rpm -qilp" "rpm -ivh") - '("\\.dia\\'" "dia") - '("\\.mgp\\'" "mgp") - - ;; Some other popular archivers. - (list "\\.zip\\'" "unzip" "unzip -l" - ;; Extract files into a separate subdirectory - '(concat "unzip" (if dired-guess-shell-gzip-quiet " -q") - " -d " (file-name-sans-extension file))) - '("\\.zoo\\'" "zoo x//") - '("\\.lzh\\'" "lharc x") - '("\\.arc\\'" "arc x") - '("\\.shar\\'" "unshar") - '("\\.rar\\'" "unrar x") - '("\\.7z\\'" "7z x") - - ;; Compression. - (list "\\.g?z\\'" '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q"))) - (list "\\.dz\\'" "dictunzip") - (list "\\.bz2\\'" "bunzip2") - (list "\\.xz\\'" "unxz") - (list "\\.Z\\'" "uncompress" - ;; Optional conversion to gzip format. - '(concat "znew" (if dired-guess-shell-gzip-quiet " -q") - " " dired-guess-shell-znew-switches)) - - '("\\.sign?\\'" "gpg --verify")) - - "Default alist used for shell command guessing. -See `dired-guess-shell-alist-user'.") - -(defcustom dired-guess-shell-alist-user nil - "User-defined alist of rules for suggested commands. -These rules take precedence over the predefined rules in the variable -`dired-guess-shell-alist-default' (to which they are prepended). - -Each element of this list looks like - - (REGEXP COMMAND...) - -COMMAND will be used if REGEXP matches the file to be processed. -If several files are to be processed, REGEXP has to match all the -files. - -Each COMMAND can either be a string or a Lisp expression that evaluates -to a string. If this expression needs to consult the name of the file for -which the shell commands are being requested, it can access that file name -as the variable `file'. - -If several COMMANDs are given, the first one will be the default -and the rest will be added temporarily to the history and can be retrieved -with `previous-history-element' (\\<minibuffer-mode-map>\\[previous-history-element]). - -The variable `dired-guess-shell-case-fold-search' controls whether -REGEXP is matched case-sensitively." - :group 'dired-x - :type '(alist :key-type regexp :value-type (repeat sexp))) - -(defcustom dired-guess-shell-case-fold-search t - "If non-nil, `dired-guess-shell-alist-default' and -`dired-guess-shell-alist-user' are matched case-insensitively." - :group 'dired-x - :type 'boolean) - -(defun dired-guess-default (files) - "Return a shell command, or a list of commands, appropriate for FILES. -See `dired-guess-shell-alist-user'." - (let* ((case-fold-search dired-guess-shell-case-fold-search) - (programs - (delete-dups - (mapcar - (lambda (command) - (eval command `((file . ,(car files))))) - (seq-reduce - #'append - (mapcar #'cdr - (seq-filter (lambda (elem) - (seq-every-p - (lambda (file) - (string-match-p (car elem) file)) - files)) - (append dired-guess-shell-alist-user - dired-guess-shell-alist-default))) - nil))))) - (if (length= programs 1) - (car programs) - programs))) - -(defun dired-guess-shell-command (prompt files) - "Ask user with PROMPT for a shell command, guessing a default from FILES." - (let ((default (dired-guess-default files)) - default-list val) - (if (null default) - ;; Nothing to guess - (read-shell-command prompt nil 'dired-shell-command-history) - (setq prompt (replace-regexp-in-string ": $" " " prompt)) - (if (listp default) - ;; More than one guess - (setq default-list default - default (car default) - prompt (concat - prompt - (format "{%d guesses} " (length default-list)))) - ;; Just one guess - (setq default-list (list default))) - ;; Put the first guess in the prompt but not in the initial value. - (setq prompt (concat prompt (format "[%s]: " default))) - ;; All guesses can be retrieved with M-n - (setq val (read-shell-command prompt nil - 'dired-shell-command-history - default-list)) - ;; If we got a return, then return default. - (if (equal val "") default val)))) - - ;;; Visit all marked files simultaneously ;; Brief Description: diff --git a/lisp/dired.el b/lisp/dired.el index 10813e56dff..fa06c8fd441 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -53,6 +53,11 @@ :prefix "dired-" :group 'dired) +(defgroup dired-guess nil + "Guess shell command in Dired." + :prefix "dired-" + :group 'dired) + ;;;###autoload (defcustom dired-listing-switches (purecopy "-al") "Switches passed to `ls' for Dired. MUST contain the `l' option. @@ -419,6 +424,72 @@ is anywhere on its Dired line, except the beginning of the line." :type 'boolean :version "28.1") +(defcustom dired-guess-shell-case-fold-search t + "If non-nil, `dired-guess-shell-alist-default' and +`dired-guess-shell-alist-user' are matched case-insensitively." + :group 'dired-guess + :type 'boolean + :version "29.1") + +(defcustom dired-guess-shell-alist-user nil + "User-defined alist of rules for suggested commands. +These rules take precedence over the predefined rules in the variable +`dired-guess-shell-alist-default' (to which they are prepended). + +Each element of this list looks like + + (REGEXP COMMAND...) + +COMMAND will be used if REGEXP matches the file to be processed. +If several files are to be processed, REGEXP has to match all the +files. + +Each COMMAND can either be a string or a Lisp expression that evaluates +to a string. If this expression needs to consult the name of the file for +which the shell commands are being requested, it can access that file name +as the variable `file'. + +If several COMMANDs are given, the first one will be the default +and the rest will be added temporarily to the history and can be retrieved +with `previous-history-element' (\\<minibuffer-mode-map>\\[previous-history-element]). + +The variable `dired-guess-shell-case-fold-search' controls whether +REGEXP is matched case-sensitively." + :group 'dired-guess + :type '(alist :key-type regexp :value-type (repeat sexp)) + :version "29.1") + +(defcustom dired-guess-shell-gnutar + (catch 'found + (dolist (exe '("tar" "gtar")) + (if (with-temp-buffer + (ignore-errors (call-process exe nil t nil "--version")) + (and (re-search-backward "GNU tar" nil t) t)) + (throw 'found exe)))) + "If non-nil, name of GNU tar executable. +\(E.g., \"tar\" or \"gtar\"). The `z' switch will be used with it for +compressed or gzip'ed tar files. If you don't have GNU tar, set this +to nil: a pipe using `zcat' or `gunzip -c' will be used." + ;; Changed from system-type test to testing --version output. + ;; Maybe test --help for -z instead? + :group 'dired-guess + :type '(choice (const :tag "Not GNU tar" nil) + (string :tag "Command name")) + :version "29.1") + +(defcustom dired-guess-shell-gzip-quiet t + "Non-nil says pass -q to gzip overriding verbose GZIP environment." + :group 'dired-guess + :type 'boolean + :version "29.1") + +(defcustom dired-guess-shell-znew-switches nil + "If non-nil, then string of switches passed to `znew', example: \"-K\"." + :group 'dired-guess + :type '(choice (const :tag "None" nil) + (string :tag "Switches")) + :version "29.1") + ;;; Internal variables @@ -715,7 +786,7 @@ Subexpression 2 must end right before the \\n.") nil '(1 'dired-broken-symlink) '(2 dired-symlink-face) - '(3 'dired-broken-symlink))) + '(3 '(face dired-broken-symlink dired-symlink-filename t)))) ;; ;; Symbolic link to a directory. (list dired-re-sym @@ -727,7 +798,7 @@ Subexpression 2 must end right before the \\n.") '(dired-move-to-filename) nil '(1 dired-symlink-face) - '(2 dired-directory-face))) + '(2 '(face dired-directory-face dired-symlink-filename t)))) ;; ;; Symbolic link to a non-directory. (list dired-re-sym @@ -741,7 +812,7 @@ Subexpression 2 must end right before the \\n.") '(dired-move-to-filename) nil '(1 dired-symlink-face) - '(2 'default))) + '(2 '(face default dired-symlink-filename t)))) ;; ;; Sockets, pipes, block devices, char devices. (list dired-re-special @@ -1191,13 +1262,13 @@ The return value is the target column for the file names." (dired-goto-next-file) ;; Use point difference instead of `current-column', because ;; the former works when `dired-hide-details-mode' is enabled. - (let* ((first (- (point) (point-at-bol))) + (let* ((first (- (point) (line-beginning-position))) (target first)) (while (and (not (eobp)) (progn (forward-line) (dired-move-to-filename))) - (when-let* ((distance (- (point) (point-at-bol))) + (when-let* ((distance (- (point) (line-beginning-position))) (higher (> distance target))) (setq target distance))) (and (/= first target) target)))) @@ -1213,7 +1284,7 @@ The return value is the target column for the file names." (while (dired-move-to-filename) ;; Use point difference instead of `current-column', because ;; the former works when `dired-hide-details-mode' is enabled. - (let ((distance (- target (- (point) (point-at-bol)))) + (let ((distance (- target (- (point) (line-beginning-position)))) (inhibit-read-only t)) (unless (zerop distance) (re-search-backward regexp nil t) @@ -4848,16 +4919,12 @@ Interactively with prefix argument, read FILE-NAME." ;;; Miscellaneous commands (declare-function Man-getpage-in-background "man" (topic)) -(declare-function dired-guess-shell-command "dired-x" (prompt files)) (defvar manual-program) ; from man.el (defun dired-do-man () "In Dired, run `man' on this file." (interactive nil dired-mode) (require 'man) - ;; FIXME: Move `dired-guess-shell-command' to dired.el to remove the - ;; need for requiring `dired-x'. - (require 'dired-x) (let* ((file (dired-get-file-for-visit)) (manual-program (string-replace "*" "%s" (dired-guess-shell-command diff --git a/lisp/doc-view.el b/lisp/doc-view.el index f05ec938e55..29da3b42977 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -458,62 +458,60 @@ Typically \"page-%s.png\".") ;;;; DocView Keymaps -(defvar doc-view-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map image-mode-map) - ;; Navigation in the document - (define-key map (kbd "n") 'doc-view-next-page) - (define-key map (kbd "p") 'doc-view-previous-page) - (define-key map (kbd "<next>") 'forward-page) - (define-key map (kbd "<prior>") 'backward-page) - (define-key map [remap forward-page] 'doc-view-next-page) - (define-key map [remap backward-page] 'doc-view-previous-page) - (define-key map (kbd "SPC") 'doc-view-scroll-up-or-next-page) - (define-key map (kbd "S-SPC") 'doc-view-scroll-down-or-previous-page) - (define-key map (kbd "DEL") 'doc-view-scroll-down-or-previous-page) - (define-key map (kbd "C-n") 'doc-view-next-line-or-next-page) - (define-key map (kbd "<down>") 'doc-view-next-line-or-next-page) - (define-key map (kbd "C-p") 'doc-view-previous-line-or-previous-page) - (define-key map (kbd "<up>") 'doc-view-previous-line-or-previous-page) - (define-key map (kbd "M-<") 'doc-view-first-page) - (define-key map (kbd "M->") 'doc-view-last-page) - (define-key map [remap goto-line] 'doc-view-goto-page) - (define-key map (kbd "RET") 'image-next-line) - ;; Zoom in/out. - (define-key map "+" 'doc-view-enlarge) - (define-key map "=" 'doc-view-enlarge) - (define-key map "-" 'doc-view-shrink) - (define-key map "0" 'doc-view-scale-reset) - (define-key map [remap text-scale-adjust] 'doc-view-scale-adjust) - ;; Fit the image to the window - (define-key map "W" 'doc-view-fit-width-to-window) - (define-key map "H" 'doc-view-fit-height-to-window) - (define-key map "P" 'doc-view-fit-page-to-window) - (define-key map "F" 'doc-view-fit-window-to-page) ;F = frame - ;; Killing the buffer (and the process) - (define-key map (kbd "k") 'image-kill-buffer) - (define-key map (kbd "K") 'doc-view-kill-proc) - ;; Slicing the image - (define-key map (kbd "c s") 'doc-view-set-slice) - (define-key map (kbd "c m") 'doc-view-set-slice-using-mouse) - (define-key map (kbd "c b") 'doc-view-set-slice-from-bounding-box) - (define-key map (kbd "c r") 'doc-view-reset-slice) - ;; Centering the image - (define-key map (kbd "c h") 'doc-view-center-page-horizontally) - (define-key map (kbd "c v") 'doc-view-center-page-vertically) - ;; Searching - (define-key map (kbd "C-s") 'doc-view-search) - (define-key map (kbd "<find>") 'doc-view-search) - (define-key map (kbd "C-r") 'doc-view-search-backward) - ;; Show the tooltip - (define-key map (kbd "C-t") 'doc-view-show-tooltip) - ;; Toggle between text and image display or editing - (define-key map (kbd "C-c C-c") 'doc-view-toggle-display) - ;; Open a new buffer with doc's text contents - (define-key map (kbd "C-c C-t") 'doc-view-open-text) - (define-key map (kbd "r") 'revert-buffer) - map) - "Keymap used by `doc-view-mode' when displaying a doc as a set of images.") +(defvar-keymap doc-view-mode-map + :doc "Keymap used by `doc-view-mode' when displaying a doc as a set of images." + :parent image-mode-map + ;; Navigation in the document + "n" #'doc-view-next-page + "p" #'doc-view-previous-page + "<next>" #'forward-page + "<prior>" #'backward-page + "<remap> <forward-page>" #'doc-view-next-page + "<remap> <backward-page>" #'doc-view-previous-page + "SPC" #'doc-view-scroll-up-or-next-page + "S-SPC" #'doc-view-scroll-down-or-previous-page + "DEL" #'doc-view-scroll-down-or-previous-page + "C-n" #'doc-view-next-line-or-next-page + "<down>" #'doc-view-next-line-or-next-page + "C-p" #'doc-view-previous-line-or-previous-page + "<up>" #'doc-view-previous-line-or-previous-page + "M-<" #'doc-view-first-page + "M->" #'doc-view-last-page + "<remap> <goto-line>" #'doc-view-goto-page + "RET" #'image-next-line + ;; Zoom in/out. + "+" #'doc-view-enlarge + "=" #'doc-view-enlarge + "-" #'doc-view-shrink + "0" #'doc-view-scale-reset + "<remap> <text-scale-adjust>" #'doc-view-scale-adjust + ;; Fit the image to the window + "W" #'doc-view-fit-width-to-window + "H" #'doc-view-fit-height-to-window + "P" #'doc-view-fit-page-to-window + "F" #'doc-view-fit-window-to-page ;F = frame + ;; Killing the buffer (and the process) + "k" #'image-kill-buffer + "K" #'doc-view-kill-proc + ;; Slicing the image + "c s" #'doc-view-set-slice + "c m" #'doc-view-set-slice-using-mouse + "c b" #'doc-view-set-slice-from-bounding-box + "c r" #'doc-view-reset-slice + ;; Centering the image + "c h" #'doc-view-center-page-horizontally + "c v" #'doc-view-center-page-vertically + ;; Searching + "C-s" #'doc-view-search + "<find>" #'doc-view-search + "C-r" #'doc-view-search-backward + ;; Show the tooltip + "C-t" #'doc-view-show-tooltip + ;; Toggle between text and image display or editing + "C-c C-c" #'doc-view-toggle-display + ;; Open a new buffer with doc's text contents + "C-c C-t" #'doc-view-open-text + "r" #'revert-buffer) (define-obsolete-function-alias 'doc-view-revert-buffer #'revert-buffer "27.1") (defvar revert-buffer-preserve-modes) @@ -617,12 +615,10 @@ Typically \"page-%s.png\".") :help "Jump to the previous match or initiate a new search"] )) -(defvar doc-view-minor-mode-map - (let ((map (make-sparse-keymap))) - ;; Toggle between text and image display or editing - (define-key map (kbd "C-c C-c") 'doc-view-toggle-display) - map) - "Keymap used by `doc-view-minor-mode'.") +(defvar-keymap doc-view-minor-mode-map + :doc "Keymap used by `doc-view-minor-mode'." + ;; Toggle between text and image display or editing + "C-c C-c" #'doc-view-toggle-display) (easy-menu-define doc-view-minor-mode-menu doc-view-minor-mode-map "Menu for Doc View minor mode." @@ -2178,12 +2174,11 @@ See the command `doc-view-mode' for more information on this mode." ;;;; Presentation mode -(defvar doc-view-presentation-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\e" 'doc-view-presentation-exit) - (define-key map "q" 'doc-view-presentation-exit) - ;; (define-key map "C" 'doc-view-convert-all-pages) - map)) +(defvar-keymap doc-view-presentation-mode-map + "ESC" #'doc-view-presentation-exit + "q" #'doc-view-presentation-exit + ;; "C" #'doc-view-convert-all-pages + ) (defvar-local doc-view-presentation--src-data nil) diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el index d5f3fc77560..aa415a3e9e3 100644 --- a/lisp/ecomplete.el +++ b/lisp/ecomplete.el @@ -199,7 +199,7 @@ matches." (goto-char (point-min)) (forward-line line) (save-restriction - (narrow-to-region (point) (point-at-eol)) + (narrow-to-region (point) (line-end-position)) (while (not (eobp)) ;; Put the 'region face on any characters on this line that ;; aren't already highlighted. diff --git a/lisp/edmacro.el b/lisp/edmacro.el index efffab9b30b..26a5d2347f0 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -626,7 +626,7 @@ The string represents the same events; Meta is indicated by bit 7. This function assumes that the events can be stored in a string." (setq seq (copy-sequence seq)) (cl-loop for i below (length seq) do - (when (logand (aref seq i) 128) + (when (/= (logand (aref seq i) 128) 0) (setf (aref seq i) (logand (aref seq i) 127)))) seq) diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index e5adb0dda73..e4d64615055 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -666,7 +666,8 @@ To toggle the mode in a single buffer, use `electric-pair-local-mode'." ;;;###autoload (define-minor-mode electric-pair-local-mode "Toggle `electric-pair-mode' only in this buffer." - :variable (buffer-local-value 'electric-pair-mode (current-buffer)) + :variable ( electric-pair-mode . + (lambda (val) (setq-local electric-pair-mode val))) (cond ((eq electric-pair-mode (default-value 'electric-pair-mode)) (kill-local-variable 'electric-pair-mode)) diff --git a/lisp/electric.el b/lisp/electric.el index f2ff837333f..bd7ea527ba9 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -340,7 +340,8 @@ use `electric-indent-local-mode'." ;;;###autoload (define-minor-mode electric-indent-local-mode "Toggle `electric-indent-mode' only in this buffer." - :variable (buffer-local-value 'electric-indent-mode (current-buffer)) + :variable ( electric-indent-mode . + (lambda (val) (setq-local electric-indent-mode val))) (cond ((eq electric-indent-mode (default-value 'electric-indent-mode)) (kill-local-variable 'electric-indent-mode)) @@ -484,7 +485,8 @@ The variable `electric-layout-rules' says when and how to insert newlines." ;;;###autoload (define-minor-mode electric-layout-local-mode "Toggle `electric-layout-mode' only in this buffer." - :variable (buffer-local-value 'electric-layout-mode (current-buffer)) + :variable ( electric-layout-mode . + (lambda (val) (setq-local electric-layout-mode val))) (cond ((eq electric-layout-mode (default-value 'electric-layout-mode)) (kill-local-variable 'electric-layout-mode)) @@ -661,7 +663,8 @@ use `electric-quote-local-mode'." ;;;###autoload (define-minor-mode electric-quote-local-mode "Toggle `electric-quote-mode' only in this buffer." - :variable (buffer-local-value 'electric-quote-mode (current-buffer)) + :variable ( electric-quote-mode . + (lambda (val) (setq-local electric-quote-mode val))) (cond ((eq electric-quote-mode (default-value 'electric-quote-mode)) (kill-local-variable 'electric-quote-mode)) diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 4f98bf3f4f5..70473770d16 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -591,7 +591,7 @@ content of the sexp." (begin (previous-single-property-change end 'backtrace-form nil (point-min)))) (unless tag - (when (or (= end (point-max)) (> end (point-at-eol))) + (when (or (= end (point-max)) (> end (line-end-position))) (user-error "No form here to reformat")) (goto-char end) (setq pos end diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index bbe8135f04a..27b0d33d3ef 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -728,17 +728,20 @@ for speeding up processing.") (while (let ((head (car-safe form))) (cond ((memq head '( progn inline save-excursion save-restriction save-current-buffer)) - (setq form (car (last form))) + (setq form (car (last (cdr form)))) t) - ((memq head '(let let* setq setcar setcdr)) + ((memq head '(let let*)) (setq form (car (last (cddr form)))) t) ((memq head '( prog1 unwind-protect copy-sequence identity reverse nreverse sort)) (setq form (nth 1 form)) t) - ((eq head 'mapc) + ((memq head '(mapc setq setcar setcdr puthash)) (setq form (nth 2 form)) + t) + ((memq head '(aset put function-put)) + (setq form (nth 3 form)) t)))) form) @@ -753,22 +756,44 @@ for speeding up processing.") ((memq head ;; FIXME: Replace this list with a function property? '( length safe-length cons lambda - string make-string format concat + string unibyte-string make-string concat + format format-message substring substring-no-properties string-replace replace-regexp-in-string symbol-name make-symbol + compare-strings string-distance mapconcat vector make-vector vconcat make-record record regexp-quote regexp-opt buffer-string buffer-substring buffer-substring-no-properties - current-buffer buffer-size - point point-min point-max - following-char preceding-char max-char - + - * / % 1+ 1- min max abs - logand logior lorxor lognot ash + current-buffer buffer-size get-buffer-create + point point-min point-max buffer-end count-lines + following-char preceding-char get-byte max-char + region-beginning region-end + line-beginning-position line-end-position + pos-bol pos-eol + + - * / % 1+ 1- min max abs mod expt logb + logand logior logxor lognot ash logcount + floor ceiling round truncate + sqrt sin cos tan asin acos atan exp log copysign + ffloor fceiling fround ftruncate float + ldexp frexp number-to-string string-to-number - int-to-string char-to-string prin1-to-string + int-to-string char-to-string + prin1-to-string read-from-string byte-to-string string-to-vector string-to-char + capitalize upcase downcase + propertize + string-as-multibyte string-as-unibyte + string-to-multibyte string-to-unibyte + string-make-multibyte string-make-unibyte + string-width char-width + make-hash-table hash-table-count + unibyte-char-to-multibyte multibyte-char-to-unibyte + sxhash sxhash-equal sxhash-eq sxhash-eql + sxhash-equal-including-properties + make-marker copy-marker point-marker mark-marker + kbd key-description always)) t) ((eq head 'if) @@ -1298,9 +1323,6 @@ See Info node `(elisp) Integer Basics'." (list 'progn condition nil))))) (defun byte-optimize-while (form) - ;; FIXME: This check does not belong here, move! - (when (< (length form) 2) - (byte-compile-warn-x form "too few arguments for `while'")) (let ((condition (nth 1 form))) (if (byte-compile-nilconstp condition) condition @@ -1570,7 +1592,7 @@ See Info node `(elisp) Integer Basics'." keymap-parent lax-plist-get ldexp length length< length> length= - line-beginning-position line-end-position + line-beginning-position line-end-position pos-bol pos-eol local-variable-if-set-p local-variable-p locale-info log log10 logand logb logcount logior lognot logxor lsh make-byte-code make-list make-string make-symbol mark marker-buffer max diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 4a2860cd43d..9a56ba0f7ad 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -568,7 +568,6 @@ ACCESS-TYPE if non-nil should specify the kind of access that will trigger (purecopy (list current-name access-type when))) obsolete-name) - (defmacro define-obsolete-variable-alias ( obsolete-name current-name when &optional docstring) "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 907015eb48e..a16486dc31c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1161,7 +1161,7 @@ message buffer `default-directory'." ;; Log something that isn't a warning. (defun byte-compile-log-1 (string) - (with-current-buffer byte-compile-log-buffer + (with-current-buffer (get-buffer-create byte-compile-log-buffer) (let ((inhibit-read-only t)) (goto-char (point-max)) (byte-compile-warning-prefix nil nil) @@ -1235,7 +1235,8 @@ Order is by depth-first search." (let (new-l new-c) (save-excursion (goto-char offset) - (setq new-l (1+ (count-lines (point-min) (point-at-bol))) + (setq new-l (1+ (count-lines (point-min) + (line-beginning-position))) new-c (1+ (current-column))) (format "%d:%d:" new-l new-c)))) "")) @@ -1355,16 +1356,23 @@ FORMAT and ARGS are as in `byte-compile-warn'." (let ((byte-compile-form-stack (cons arg byte-compile-form-stack))) (apply #'byte-compile-warn format args))) -(defun byte-compile-warn-obsolete (symbol) - "Warn that SYMBOL (a variable or function) is obsolete." +;;;###autoload +(defun byte-compile-warn-obsolete (symbol type) + "Warn that SYMBOL (a variable, function or generalized variable) is obsolete. +TYPE is a string that say which one of these three types it is." (when (byte-compile-warning-enabled-p 'obsolete symbol) - (let* ((funcp (get symbol 'byte-obsolete-info)) - (msg (macroexp--obsolete-warning - symbol - (or funcp (get symbol 'byte-obsolete-variable)) - (if funcp "function" "variable")))) - (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs)) - (byte-compile-warn-x symbol "%s" msg))))) + (byte-compile-warn-x + symbol "%s" + (macroexp--obsolete-warning + symbol + (pcase type + ("function" + (get symbol 'byte-obsolete-info)) + ("variable" + (get symbol 'byte-obsolete-variable)) + ("generalized variable" + (get symbol 'byte-obsolete-generalized-variable))) + type)))) (defun byte-compile-report-error (error-info &optional fill) "Report Lisp error in compilation. @@ -1468,8 +1476,8 @@ when printing the error message." (defun byte-compile-function-warn (f nargs def) (when (and (get f 'byte-obsolete-info) - (byte-compile-warning-enabled-p 'obsolete f)) - (byte-compile-warn-obsolete f)) + (not (memq f byte-compile-not-obsolete-funcs))) + (byte-compile-warn-obsolete f "function")) ;; Check to see if the function will be available at runtime ;; and/or remember its arity if it's unknown. @@ -3604,7 +3612,7 @@ lambda-expression." ('set (not (eq access-type 'reference))) ('get (eq access-type 'reference)) (_ t)))) - (byte-compile-warn-obsolete var)))) + (byte-compile-warn-obsolete var "variable")))) (defsubst byte-compile-dynamic-variable-op (base-op var) (let ((tmp (assq var byte-compile-variables))) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index ac6cbb53a56..9ff893b75b6 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -112,7 +112,7 @@ too much in text characters anyways.") (set-face-foreground nf "black") (if (and chart-face-use-pixmaps pl) (condition-case nil - (set-face-background-pixmap nf (car pl)) + (set-face-stipple nf (car pl)) (error (message "Cannot set background pixmap %s" (car pl))))) (push nf faces) (setq cl (cdr cl) @@ -526,9 +526,9 @@ cons cells of the form (NAME . NUM). See `sort' for more details." (defun chart-zap-chars (n) "Zap up to N chars without deleting EOLs." (if (not (eobp)) - (if (< n (- (point-at-eol) (point))) + (if (< n (- (line-end-position) (point))) (delete-char n) - (delete-region (point) (point-at-eol))))) + (delete-region (point) (line-end-position))))) (defun chart-display-label (label dir zone start end &optional face) "Display LABEL in direction DIR in column/row ZONE between START and END. diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 04ead562f2f..a5ab3a50ff2 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2232,7 +2232,6 @@ nil." (progn (ispell-set-spellchecker-params) ; Initialize variables and dict alists. (ispell-accept-buffer-local-defs) ; Use the correct dictionary. - ;; This code copied in part from ispell.el Emacs 19.34 (dolist (w checkdoc-ispell-lisp-words) (process-send-string ispell-process (concat "@" w "\n")))) (error (setq checkdoc-spellcheck-documentation-flag nil))))) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 64ae05bf2a0..60e204eaf51 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -139,6 +139,10 @@ only case where FUNCTION is called with fewer than two arguments. If SEQ contains exactly one element and no :INITIAL-VALUE is specified, then return that element and FUNCTION is not called. +If :FROM-END is non-nil, the reduction occurs from the back of +the SEQ moving forward, and the order of arguments to the +FUNCTION is also reversed. + \n(fn FUNCTION SEQ [KEYWORD VALUE]...)" (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) () (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 6451e34c42f..8cff06a383a 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -37,16 +37,12 @@ (require 'cl-lib) -(defconst comp--typeof-types (mapcar (lambda (x) - (append x '(t))) - cl--typeof-types) +(defconst comp--typeof-builtin-types (mapcar (lambda (x) + (append x '(t))) + cl--typeof-types) ;; TODO can we just add t in `cl--typeof-types'? "Like `cl--typeof-types' but with t as common supertype.") -(defconst comp--all-builtin-types - (append cl--all-builtin-types '(t)) - "Likewise like `cl--all-builtin-types' but with t as common supertype.") - (cl-defstruct (comp-cstr (:constructor comp-type-to-cstr (type &aux (null (eq type 'null)) @@ -234,7 +230,7 @@ Return them as multiple value." (cl-loop named outer with found = nil - for l in comp--typeof-types + for l in comp--typeof-builtin-types do (cl-loop for x in l for i from (length l) downto 0 @@ -277,7 +273,7 @@ Return them as multiple value." (cl-loop with types = (apply #'append typesets) with res = '() - for lane in comp--typeof-types + for lane in comp--typeof-builtin-types do (cl-loop with last = nil for x in lane diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 5ee10fcbca2..e10443588e4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -304,7 +304,7 @@ Useful to hook into pass checkers.") (bool-vector-subsetp (function (bool-vector bool-vector) boolean)) (boundp (function (symbol) boolean)) (buffer-end (function ((or number marker)) integer)) - (buffer-file-name (function (&optional buffer) string)) + (buffer-file-name (function (&optional buffer) (or string null))) (buffer-list (function (&optional frame) list)) (buffer-local-variables (function (&optional buffer) list)) (buffer-modified-p (function (&optional buffer) boolean)) @@ -321,8 +321,8 @@ Useful to hook into pass checkers.") (cdr (function (list) t)) (cdr-safe (function (t) t)) (ceiling (function (number &optional number) integer)) - (char-after (function (&optional (or marker integer)) fixnum)) - (char-before (function (&optional (or marker integer)) fixnum)) + (char-after (function (&optional (or marker integer)) (or fixnum null))) + (char-before (function (&optional (or marker integer)) (or fixnum null))) (char-equal (function (integer integer) boolean)) (char-or-string-p (function (t) boolean)) (char-to-string (function (fixnum) string)) @@ -344,14 +344,21 @@ Useful to hook into pass checkers.") (current-buffer (function () buffer)) (current-global-map (function () cons)) (current-indentation (function () integer)) - (current-local-map (function () cons)) - (current-minor-mode-maps (function () cons)) + (current-local-map (function () (or cons null))) + (current-minor-mode-maps (function () (or cons null))) (current-time (function () cons)) - (current-time-string (function (&optional string boolean) string)) - (current-time-zone (function (&optional string boolean) cons)) + (current-time-string (function (&optional (or number list) + (or symbol string cons integer)) + string)) + (current-time-zone (function (&optional (or number list) + (or symbol string cons integer)) + cons)) (custom-variable-p (function (symbol) boolean)) (decode-char (function (cons t) (or fixnum null))) - (decode-time (function (&optional string symbol symbol) cons)) + (decode-time (function (&optional (or number list) + (or symbol string cons integer) + symbol) + cons)) (default-boundp (function (symbol) boolean)) (default-value (function (symbol) t)) (degrees-to-radians (function (number) float)) @@ -383,12 +390,14 @@ Useful to hook into pass checkers.") (file-writable-p (function (string) boolean)) (fixnump (function (t) boolean)) (float (function (number) float)) - (float-time (function (&optional cons) float)) + (float-time (function (&optional (or number list)) float)) (floatp (function (t) boolean)) (floor (function (number &optional number) integer)) (following-char (function () fixnum)) (format (function (string &rest t) string)) - (format-time-string (function (string &optional cons symbol) string)) + (format-time-string (function (string &optional (or number list) + (or symbol string cons integer)) + string)) (frame-first-window (function ((or frame window)) window)) (frame-root-window (function (&optional (or frame window)) window)) (frame-selected-window (function (&optional (or frame window)) window)) @@ -400,8 +409,8 @@ Useful to hook into pass checkers.") (get-buffer (function ((or buffer string)) (or buffer null))) (get-buffer-window (function (&optional (or buffer string) (or symbol (integer 0 0))) (or null window))) (get-file-buffer (function (string) (or null buffer))) - (get-largest-window (function (&optional t t t) window)) - (get-lru-window (function (&optional t t t) window)) + (get-largest-window (function (&optional t t t) (or window null))) + (get-lru-window (function (&optional t t t) (or window null))) (getenv (function (string &optional frame) (or null string))) (gethash (function (t hash-table &optional t) t)) (hash-table-count (function (hash-table) integer)) @@ -450,7 +459,7 @@ Useful to hook into pass checkers.") (make-symbol (function (string) symbol)) (mark (function (&optional t) (or integer null))) (mark-marker (function () marker)) - (marker-buffer (function (marker) buffer)) + (marker-buffer (function (marker) (or buffer null))) (markerp (function (t) boolean)) (max (function ((or number marker) &rest (or number marker)) number)) (max-char (function () fixnum)) @@ -459,7 +468,7 @@ Useful to hook into pass checkers.") (memq (function (t list) list)) (memql (function (t list) list)) (min (function ((or number marker) &rest (or number marker)) number)) - (minibuffer-selected-window (function () window)) + (minibuffer-selected-window (function () (or window null))) (minibuffer-window (function (&optional frame) window)) (mod (function ((or number marker) (or number marker)) (or (integer 0 *) (float 0 *)))) (mouse-movement-p (function (t) boolean)) @@ -487,7 +496,7 @@ Useful to hook into pass checkers.") (previous-window (function (&optional window t t) window)) (prin1-to-string (function (t &optional t t) string)) (processp (function (t) boolean)) - (proper-list-p (function (t) integer)) + (proper-list-p (function (t) boolean)) (propertize (function (string &rest t) string)) (radians-to-degrees (function (number) float)) (rassoc (function (t list) list)) @@ -520,7 +529,7 @@ Useful to hook into pass checkers.") (string-to-char (function (string) fixnum)) (string-to-multibyte (function (string) string)) (string-to-number (function (string &optional integer) number)) - (string-to-syntax (function (string) cons)) + (string-to-syntax (function (string) (or cons null))) (string< (function ((or string symbol) (or string symbol)) boolean)) (string= (function ((or string symbol) (or string symbol)) boolean)) (stringp (function (t) boolean)) @@ -542,7 +551,8 @@ Useful to hook into pass checkers.") (this-command-keys-vector (function () vector)) (this-single-command-keys (function () vector)) (this-single-command-raw-keys (function () vector)) - (time-convert (function (t &optional (or boolean integer)) cons)) + (time-convert (function ((or number list) &optional (or symbol integer)) + (or cons number))) (truncate (function (number &optional number) integer)) (type-of (function (t) symbol)) (unibyte-char-to-multibyte (function (fixnum) fixnum)) ;; byte is fixnum diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 43ce1872f9b..41e3a197af4 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -492,25 +492,11 @@ To implement dynamic menus, either call this from `menu-bar-update-hook' or use a menu filter." (easy-menu-add-item map path (easy-menu-create-menu name items) before)) -(defalias 'easy-menu-remove #'ignore - "Remove MENU from the current menu bar. -Contrary to XEmacs, this is a nop on Emacs since menus are automatically -\(de)activated when the corresponding keymap is (de)activated. - -\(fn MENU)") +(defalias 'easy-menu-remove #'ignore) (make-obsolete 'easy-menu-remove "this was always a no-op in Emacs \ and can be safely removed." "28.1") -(defalias 'easy-menu-add #'ignore - "Add the menu to the menubar. -On Emacs this is a nop, because menus are already automatically -activated when the corresponding keymap is activated. On XEmacs -this is needed to actually add the menu to the current menubar. - -You should call this once the menu and keybindings are set up -completely and menu filter functions can be expected to work. - -\(fn MENU &optional MAP)") +(defalias 'easy-menu-add #'ignore) (make-obsolete 'easy-menu-add "this was always a no-op in Emacs \ and can be safely removed." "28.1") diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index dff16df0029..9de8999fdfd 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2861,7 +2861,6 @@ See `edebug-behavior-alist' for implementations.") (this-command this-command) (current-prefix-arg nil) - ;; More for Emacs 19 (last-input-event nil) (last-command-event nil) (last-event-frame nil) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 03c5b94e3b4..cbf38e7dd88 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -111,7 +111,7 @@ ;; provide the functionality or interface that I wanted, so I wrote ;; this. -;; Unlike previous profilers, elp uses Emacs 19's built-in function +;; Unlike previous profilers, elp uses the built-in function ;; current-time to return interval times. This obviates the need for ;; both an external C program and Emacs processes to communicate with ;; such a program, and thus simplifies the package as a whole. diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 54ddc7ac757..eaab6439adb 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -92,6 +92,9 @@ DO must return an Elisp expression." (t (let* ((head (car place)) (gf (function-get head 'gv-expander 'autoload))) + (when (and (symbolp head) + (get head 'byte-obsolete-generalized-variable)) + (byte-compile-warn-obsolete head "generalized variable")) (if gf (apply gf do (cdr place)) (let ((me (macroexpand-1 place ;; (append macroexpand-all-environment @@ -166,6 +169,18 @@ arguments as NAME. DO is a function as defined in `gv-get'." ;; (`(expand ,expander) `(gv-define-expand ,name ,expander)) (_ (message "Unknown %s declaration %S" symbol handler) nil)))) +(defun make-obsolete-generalized-variable (obsolete-name current-name when) + "Make byte-compiler warn that generalized variable OBSOLETE-NAME is obsolete. +The warning will say that CURRENT-NAME should be used instead. + +If CURRENT-NAME is a string, that is the `use instead' message. + +WHEN should be a string indicating when the variable was first +made obsolete, for example a date or a release number." + (put obsolete-name 'byte-obsolete-generalized-variable + (purecopy (list current-name when))) + obsolete-name) + ;; Additions for `declare'. We specify the values as named aliases so ;; that `describe-variable' prints something useful; cf. Bug#40491. @@ -392,6 +407,7 @@ The return value is the last VAL in the list. (gv-define-setter buffer-local-value (val var buf) (macroexp-let2 nil v val `(with-current-buffer ,buf (set (make-local-variable ,var) ,v)))) +(make-obsolete-generalized-variable 'buffer-local-value nil "29.1") (gv-define-expander alist-get (lambda (do key alist &optional default remove testfn) @@ -618,71 +634,160 @@ REF must have been previously obtained with `gv-ref'." ;; Some Emacs-related place types. (gv-define-simple-setter buffer-file-name set-visited-file-name t) +(make-obsolete-generalized-variable + 'buffer-file-name 'set-visited-file-name "29.1") + (gv-define-setter buffer-modified-p (flag &optional buf) (macroexp-let2 nil buffer `(or ,buf (current-buffer)) `(with-current-buffer ,buffer (set-buffer-modified-p ,flag)))) +(make-obsolete-generalized-variable + 'buffer-modified-p 'set-buffer-modified-p "29.1") + (gv-define-simple-setter buffer-name rename-buffer t) +(make-obsolete-generalized-variable 'buffer-name 'rename-buffer "29.1") + (gv-define-setter buffer-string (store) `(insert (prog1 ,store (erase-buffer)))) +(make-obsolete-generalized-variable 'buffer-string nil "29.1") + (gv-define-simple-setter buffer-substring cl--set-buffer-substring) +(make-obsolete-generalized-variable 'buffer-substring nil "29.1") + (gv-define-simple-setter current-buffer set-buffer) +(make-obsolete-generalized-variable 'current-buffer 'set-buffer "29.1") + (gv-define-simple-setter current-column move-to-column t) +(make-obsolete-generalized-variable 'current-column 'move-to-column "29.1") + (gv-define-simple-setter current-global-map use-global-map t) +(make-obsolete-generalized-variable 'current-global-map 'use-global-map "29.1") + (gv-define-setter current-input-mode (store) `(progn (apply #'set-input-mode ,store) ,store)) +(make-obsolete-generalized-variable 'current-input-mode nil "29.1") + (gv-define-simple-setter current-local-map use-local-map t) +(make-obsolete-generalized-variable 'current-local-map 'use-local-map "29.1") + (gv-define-simple-setter current-window-configuration set-window-configuration t) +(make-obsolete-generalized-variable + 'current-window-configuration 'set-window-configuration "29.1") + (gv-define-simple-setter default-file-modes set-default-file-modes t) +(make-obsolete-generalized-variable + 'default-file-modes 'set-default-file-modes "29.1") + (gv-define-simple-setter documentation-property put) +(make-obsolete-generalized-variable 'documentation-property 'put "29.1") + (gv-define-setter face-background (x f &optional s) `(set-face-background ,f ,x ,s)) (gv-define-setter face-background-pixmap (x f &optional s) - `(set-face-background-pixmap ,f ,x ,s)) + `(set-face-stipple ,f ,x ,s)) +(make-obsolete-generalized-variable 'face-background-pixmap 'face-stipple "29.1") +(gv-define-setter face-stipple (x f &optional s) + `(set-face-stipple ,f ,x ,s)) (gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s)) (gv-define-setter face-foreground (x f &optional s) `(set-face-foreground ,f ,x ,s)) (gv-define-setter face-underline-p (x f &optional s) `(set-face-underline ,f ,x ,s)) (gv-define-simple-setter file-modes set-file-modes t) + (gv-define-setter frame-height (x &optional frame) `(set-frame-height (or ,frame (selected-frame)) ,x)) +(make-obsolete-generalized-variable 'frame-height 'set-frame-height "29.1") + (gv-define-simple-setter frame-parameters modify-frame-parameters t) (gv-define-simple-setter frame-visible-p cl--set-frame-visible-p) +(make-obsolete-generalized-variable 'frame-visible-p nil "29.1") + (gv-define-setter frame-width (x &optional frame) `(set-frame-width (or ,frame (selected-frame)) ,x)) +(make-obsolete-generalized-variable 'frame-width 'set-frame-width "29.1") + (gv-define-simple-setter getenv setenv t) (gv-define-simple-setter get-register set-register) + (gv-define-simple-setter global-key-binding global-set-key) +(make-obsolete-generalized-variable 'global-key-binding 'global-set-key "29.1") + (gv-define-simple-setter local-key-binding local-set-key) +(make-obsolete-generalized-variable 'local-key-binding 'local-set-key "29.1") + (gv-define-simple-setter mark set-mark t) +(make-obsolete-generalized-variable 'mark 'set-mark "29.1") + (gv-define-simple-setter mark-marker set-mark t) +(make-obsolete-generalized-variable 'mark-marker 'set-mark "29.1") + (gv-define-simple-setter marker-position set-marker t) +(make-obsolete-generalized-variable 'marker-position 'set-marker "29.1") + (gv-define-setter mouse-position (store scr) `(set-mouse-position ,scr (car ,store) (cadr ,store) (cddr ,store))) +(make-obsolete-generalized-variable 'mouse-position 'set-mouse-position "29.1") + (gv-define-simple-setter point goto-char) +(make-obsolete-generalized-variable 'point 'goto-char "29.1") + (gv-define-simple-setter point-marker goto-char t) +(make-obsolete-generalized-variable 'point-marker 'goto-char "29.1") + (gv-define-setter point-max (store) `(progn (narrow-to-region (point-min) ,store) ,store)) +(make-obsolete-generalized-variable 'point-max 'narrow-to-region "29.1") + (gv-define-setter point-min (store) `(progn (narrow-to-region ,store (point-max)) ,store)) +(make-obsolete-generalized-variable 'point-min 'narrow-to-region "29.1") + (gv-define-setter read-mouse-position (store scr) `(set-mouse-position ,scr (car ,store) (cdr ,store))) +(make-obsolete-generalized-variable + 'read-mouse-position 'set-mouse-position "29.1") + (gv-define-simple-setter screen-height set-screen-height t) +(make-obsolete-generalized-variable 'screen-height 'set-screen-height "29.1") + (gv-define-simple-setter screen-width set-screen-width t) +(make-obsolete-generalized-variable 'screen-width 'set-screen-width "29.1") + (gv-define-simple-setter selected-window select-window) +(make-obsolete-generalized-variable 'selected-window 'select-window "29.1") + (gv-define-simple-setter selected-screen select-screen) +(make-obsolete-generalized-variable 'selected-screen 'select-screen "29.1") + (gv-define-simple-setter selected-frame select-frame) +(make-obsolete-generalized-variable 'selected-frame 'select-frame "29.1") + (gv-define-simple-setter standard-case-table set-standard-case-table) +(make-obsolete-generalized-variable + 'standard-case-table 'set-standard-case-table "29.1") + (gv-define-simple-setter syntax-table set-syntax-table) +(make-obsolete-generalized-variable 'syntax-table 'set-syntax-table "29.1") + (gv-define-simple-setter visited-file-modtime set-visited-file-modtime t) +(make-obsolete-generalized-variable + 'visited-file-modtime 'set-visited-file-modtime "29.1") + (gv-define-setter window-height (store) `(progn (enlarge-window (- ,store (window-height))) ,store)) +(make-obsolete-generalized-variable 'window-height 'enlarge-window "29.1") + (gv-define-setter window-width (store) `(progn (enlarge-window (- ,store (window-width)) t) ,store)) +(make-obsolete-generalized-variable 'window-width 'enlarge-window "29.1") + (gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t) +(make-obsolete-generalized-variable + 'x-get-secondary-selection 'x-own-secondary-selection "29.1") + ;; More complex setf-methods. diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index 277b285c2ef..93749a3451e 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -189,8 +189,10 @@ present if the icon is represented by an image." (cl-defmethod icons--create ((_type (eql 'image)) icon keywords) (let ((file (if (file-name-absolute-p icon) icon - (image-search-load-path icon)))) + (and (fboundp 'image-search-load-path) + (image-search-load-path icon))))) (and (display-images-p) + (fboundp 'image-supported-file-p) (image-supported-file-p file) (propertize " " 'display diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index c56a9660e7c..c906ee6e31d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -728,67 +728,30 @@ font-lock keywords will not be case sensitive." len)))) (defun lisp-current-defun-name () - "Return the name of the defun at point. -If there is no defun at point, return the first symbol from the -top-level form. If there is no top-level form, return nil. - -(\"defun\" here means \"form that defines something\", and is -decided heuristically.)" + "Return the name of the defun at point, or nil." (save-excursion - (let ((location (point)) - name) + (let ((location (point))) ;; If we are now precisely at the beginning of a defun, make sure ;; beginning-of-defun finds that one rather than the previous one. - (unless (eobp) - (forward-char 1)) + (or (eobp) (forward-char 1)) (beginning-of-defun) ;; Make sure we are really inside the defun found, not after it. - (when (and (looking-at "(") - (progn - (end-of-defun) - (< location (point))) - (progn - (forward-sexp -1) - (>= location (point)))) - (when (looking-at "(") - (forward-char 1)) - ;; Read the defining construct name, typically "defun" or + (when (and (looking-at "\\s(") + (progn (end-of-defun) + (< location (point))) + (progn (forward-sexp -1) + (>= location (point)))) + (if (looking-at "\\s(") + (forward-char 1)) + ;; Skip the defining construct name, typically "defun" or ;; "defvar". - (let ((symbol (ignore-errors (read (current-buffer))))) - (when (and symbol (not (symbolp symbol))) - (setq symbol nil)) - ;; If there's an edebug spec, use that to determine what the - ;; name is. - (when symbol - (let ((spec (or (get symbol 'edebug-form-spec) - (and (eq (get symbol 'lisp-indent-function) 'defun) - (get 'defun 'edebug-form-spec))))) - (save-excursion - (when (and (eq (car-safe spec) '&define) - (memq 'name spec)) - (pop spec) - (while (and spec (not name)) - (let ((candidate (ignore-errors (read (current-buffer))))) - (when (eq (pop spec) 'name) - (when (and (consp candidate) - (symbolp (car (delete 'quote candidate)))) - (setq candidate (car (delete 'quote candidate)))) - (setq name candidate - spec nil)))))))) - ;; We didn't have an edebug spec (or couldn't find the - ;; name). If the symbol starts with \"def\", then it's - ;; likely that the next symbol is the name. - (when (and (not name) - (string-match-p "\\(\\`\\|-\\)def" (symbol-name symbol))) - (when-let ((candidate (ignore-errors (read (current-buffer))))) - (cond - ((symbolp candidate) - (setq name candidate)) - ((and (consp candidate) - (symbolp (car (delete 'quote candidate)))) - (setq name (car (delete 'quote candidate))))))) - (when-let ((result (or name symbol))) - (and (symbolp result) (symbol-name result)))))))) + (forward-sexp 1) + ;; The second element is usually a symbol being defined. If it + ;; is not, use the first symbol in it. + (skip-chars-forward " \t\n'(") + (buffer-substring-no-properties (point) + (progn (forward-sexp 1) + (point))))))) (defvar-keymap lisp-mode-shared-map :doc "Keymap for commands shared by all sorts of Lisp modes." diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 8413373e5d4..e13b92bab8c 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -645,7 +645,8 @@ instead of just updating them with the new/changed autoloads." (unless (equal (buffer-hash) hash) (write-region (point-min) (point-max) loaddefs-file nil 'silent) (byte-compile-info - (file-relative-name loaddefs-file lisp-directory) t "GEN")))))))) + (file-relative-name loaddefs-file (car (ensure-list dir))) + t "GEN")))))))) (defun loaddefs-generate--print-form (def) "Print DEF in a format that makes sense for version control." diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 5ae9d8368f0..c3ba1b36d44 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -187,13 +187,15 @@ It should normally be a symbol with position and it defaults to FORM." msg)) form))) -(defun macroexp--obsolete-warning (fun obsolescence-data type) +(defun macroexp--obsolete-warning (fun obsolescence-data type &optional key) (let ((instead (car obsolescence-data)) (asof (nth 2 obsolescence-data))) (format-message "`%s' is an obsolete %s%s%s" fun type (if asof (concat " (as of " asof ")") "") (cond ((stringp instead) (concat "; " (substitute-command-keys instead))) + ((and instead key) + (format-message "; use `%s' (%s) instead." instead key)) (instead (format-message "; use `%s' instead." instead)) (t "."))))) @@ -369,6 +371,11 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexp--all-forms body)) (cdr form)) form))) + (`(while) + (macroexp-warn-and-return + "missing `while' condition" + `(signal 'wrong-number-of-arguments '(while 0)) + nil 'compile-only form)) (`(setq ,(and var (pred symbolp) (pred (not booleanp)) (pred (not keywordp))) ,expr) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 46b429ce6fe..e6e8bb202da 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -497,7 +497,8 @@ Optional argument SYNTAX must be specified if called non-interactively." (setq reb-re-syntax syntax) (when buffer (with-current-buffer buffer - (reb-initialize-buffer)))) + (reb-initialize-buffer)) + (message "Switched syntax to `%s'" reb-re-syntax))) (error "Invalid syntax: %s" syntax))) @@ -737,8 +738,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (let ((face (get-text-property (1- (point)) 'face))) (when (or (and (listp face) (memq 'font-lock-string-face face)) - (eq 'font-lock-string-face face) - t) + (eq 'font-lock-string-face face)) (throw 'found t)))))))) (defface reb-regexp-grouping-backslash @@ -819,7 +819,6 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (defun reb-restart-font-lock () "Restart `font-lock-mode' to fit current regexp format." - (message "reb-restart-font-lock re-re-syntax=%s" reb-re-syntax) (with-current-buffer (get-buffer reb-buffer) (let ((font-lock-is-on font-lock-mode)) (font-lock-mode -1) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index d187af9ac83..990dabe351a 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -941,12 +941,24 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (point-min)) (point-max :eval (point-max)) + (pos-bol + :eval (pos-bol)) + (pos-eol + :eval (pos-eol)) + (bolp + :eval (bolp)) + (eolp + :eval (eolp)) (line-beginning-position :eval (line-beginning-position)) (line-end-position :eval (line-end-position)) (buffer-size :eval (buffer-size)) + (bobp + :eval (bobp)) + (eobp + :eval (eobp)) "Moving Around" (goto-char :no-eval (goto-char (point-max)) @@ -972,8 +984,13 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (following-char :no-eval (following-char) :eg-result 67) + (preceding-char + :no-eval (preceding-char) + :eg-result 38) (char-after :eval (char-after 45)) + (char-before + :eval (char-before 13)) (get-byte :no-eval (get-byte 45) :eg-result-string "#xff") @@ -982,6 +999,8 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :no-value (delete-region (point-min) (point-max))) (erase-buffer :no-value (erase-buffer)) + (delete-line + :no-value (delete-line)) (insert :no-value (insert "This string will be inserted in the buffer\n")) (subst-char-in-region diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 9868d8c4ec0..c01f3fd4fec 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -465,7 +465,7 @@ changing `tabulated-list-sort-key'." (let* ((elt (car entries)) (tabulated-list--near-rows (list - (or (tabulated-list-get-entry (point-at-bol 0)) (cadr elt)) + (or (tabulated-list-get-entry (pos-bol 0)) (cadr elt)) (cadr elt) (or (cadr (cadr entries)) (cadr elt)))) (id (car elt))) @@ -519,7 +519,7 @@ of column descriptors." (insert (make-string x ?\s))) (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506). (or (bound-and-true-p tabulated-list--near-rows) - (list (or (tabulated-list-get-entry (point-at-bol 0)) + (list (or (tabulated-list-get-entry (pos-bol 0)) cols) cols)))) (dotimes (n ncols) @@ -611,7 +611,7 @@ This function only changes the buffer contents; it does not alter (cols (tabulated-list-get-entry)) (inhibit-read-only t)) (when cols - (delete-region (line-beginning-position) (1+ (line-end-position))) + (delete-region (pos-bol) (1+ (pos-eol))) (list id cols)))) (defun tabulated-list-set-col (col desc &optional change-entry-data) @@ -625,8 +625,8 @@ by setting the appropriate slot of the vector originally used to print this entry. If `tabulated-list-entries' has a list value, this is the vector stored within it." (let* ((opoint (point)) - (eol (line-end-position)) - (pos (line-beginning-position)) + (eol (pos-eol)) + (pos (pos-bol)) (id (tabulated-list-get-id pos)) (entry (tabulated-list-get-entry pos)) (prop 'tabulated-list-column-name) @@ -651,9 +651,9 @@ this is the vector stored within it." (goto-char pos) (let ((tabulated-list--near-rows (list - (tabulated-list-get-entry (point-at-bol 0)) + (tabulated-list-get-entry (pos-bol 0)) entry - (or (tabulated-list-get-entry (point-at-bol 2)) entry)))) + (or (tabulated-list-get-entry (pos-bol 2)) entry)))) (tabulated-list-print-col col desc (current-column))) (if change-entry-data (aset entry col desc)) @@ -785,7 +785,7 @@ If ARG is provided, move that many columns." (let ((prev (or (previous-single-property-change (point) 'tabulated-list-column-name) 1))) - (unless (< prev (line-beginning-position)) + (unless (< prev (pos-bol)) (goto-char prev))))) ;;; The mode definition: diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index 3f8113dea36..cd0e8d60cca 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -647,7 +647,7 @@ Argument NUM is the number of lines to move." (bottom (save-excursion (move-to-window-line bottom-margin) (point))) (far (save-excursion (goto-char bottom) - (point-at-bol (1- height))))) + (line-beginning-position (1- height))))) (ignore top far) ,@body)) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index ddb49609d40..26793989d05 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -3266,8 +3266,8 @@ controlled by the sign of prefix numeric value." (if (and (eolp) (not (bolp))) (forward-char -1)) (if (not (looking-at "[][(){}]")) (setq anchor-point (point))) - (setq beg-lim (point-at-bol) - end-lim (point-at-eol)) + (setq beg-lim (line-beginning-position) + end-lim (line-end-position)) (cond ((re-search-forward "[][(){}]" end-lim t) (backward-char) ) ((re-search-backward "[][(){}]" beg-lim t)) @@ -4390,7 +4390,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back." (delete-char -1) (setq p (point)) (setq indent nil))) - (setq bol (point-at-bol)) + (setq bol (line-beginning-position)) (if (re-search-backward "[^ \t]" bol 1) (forward-char)) (delete-region (point) p) (if indent @@ -4474,7 +4474,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back." (goto-char pos) (beginning-of-line) (if (re-search-backward "[^ \t]" nil t) - (setq s (point-at-bol))) + (setq s (line-beginning-position))) (goto-char pos) (forward-line 1) (if (re-search-forward "[^ \t]" nil t) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index df2487a4477..7296041ae8f 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -867,8 +867,8 @@ Should be set in `viper-custom-file-name'." (defvar-local viper-minibuffer-overlay nil) (put 'viper-minibuffer-overlay 'permanent-local t) -;; Hook, specific to Viper, which is run just *before* exiting the minibuffer. -;; This is needed because beginning with Emacs 19.26, the standard +;; Hook, specific to Viper, which is run just *before* exiting the +;; minibuffer. This is needed because, the standard ;; `minibuffer-exit-hook' is run *after* exiting the minibuffer (defvar viper-minibuffer-exit-hook nil) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 25c55acf96c..46dbd7f24d5 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -1020,7 +1020,6 @@ Otherwise return the normal value." (string-to-char (symbol-name key))) ((and (listp key) (eq (car key) 'control) - (symbol-name (nth 1 key)) (= 1 (length (symbol-name (nth 1 key))))) (read (format "?\\C-%s" (symbol-name (nth 1 key))))) (t key))) diff --git a/lisp/epa.el b/lisp/epa.el index 742c37d085b..63bc0941d62 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -417,7 +417,7 @@ q trust status questionable. - trust status unspecified. 'epa-key)) (setq keys (cons key keys)))) (nreverse keys))) - (let ((key (get-text-property (point-at-bol) 'epa-key))) + (let ((key (get-text-property (line-beginning-position) 'epa-key))) (if key (list key))))) diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 28003eaf71b..6501434e030 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -246,9 +246,9 @@ version requirement is met." (goto-char (match-end 0)) (backward-char) (forward-sexp) - (skip-syntax-forward "-" (point-at-eol)) + (skip-syntax-forward "-" (line-end-position)) (list (cons 'program program) - (cons 'version (buffer-substring (point) (point-at-eol))))))) + (cons 'version (buffer-substring (point) (line-end-position))))))) ;;;###autoload (defun epg-configuration () diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 977080a4de1..dd70bfb7b70 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -357,10 +357,7 @@ Returns the newly created subprocess, or nil." :server t)) (when (processp process) (when (fboundp 'set-process-coding-system) - (set-process-coding-system process 'binary 'binary)) - (when (fboundp 'set-process-filter-multibyte) - (with-no-warnings ; obsolete since 23.1 - (set-process-filter-multibyte process nil))))) + (set-process-coding-system process 'binary 'binary)))) (file-error (unless (and (string= "Cannot bind server socket" (nth 1 err)) (string= "address already in use" (downcase (nth 2 err)))) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 11979a01301..0c32f1e51f0 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -343,7 +343,7 @@ The INDENT level is ignored." "Return the text for the item on the current line." (beginning-of-line) (when (re-search-forward "[]>] " nil t) - (buffer-substring-no-properties (point) (point-at-eol)))) + (buffer-substring-no-properties (point) (line-end-position)))) (defun erc-speedbar-item-info () "Display information about the current buffer on the current line." diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index cdab3241c12..c167cd23930 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -303,7 +303,7 @@ printed just after each line's text (no alignment)." ;; to the next line before inserting a stamp. It allows for ;; some margin of error if what is displayed on the line differs ;; from the number of characters on the line. - (setq col (+ col (ceiling (/ (- col (- (point) (point-at-bol))) 1.6)))) + (setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6)))) (if (< col pos) (erc-insert-aligned string pos) (newline) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 68276b22d95..40b83010f94 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -755,26 +755,21 @@ external command." (eshell-stringify-list (flatten-tree args))) " ")) - (cmd (format "%s -nH %s" - (pcase command - ("egrep" "grep -E") - ("fgrep" "grep -F") - (x x)) - args)) + (cmd (format "%s -n %s" command args)) compilation-scroll-output) (grep cmd))))) (defun eshell/grep (&rest args) "Use Emacs grep facility instead of calling external grep." - (eshell-grep "grep" args t)) + (eshell-grep "grep" (append '("-H") args) t)) (defun eshell/egrep (&rest args) "Use Emacs grep facility instead of calling external grep -E." - (eshell-grep "egrep" args t)) + (eshell-grep "grep" (append '("-EH") args) t)) (defun eshell/fgrep (&rest args) "Use Emacs grep facility instead of calling external grep -F." - (eshell-grep "fgrep" args t)) + (eshell-grep "grep" (append '("-FH") args) t)) (defun eshell/agrep (&rest args) "Use Emacs grep facility instead of calling external agrep." diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 27703976f6d..e5977c95807 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -501,7 +501,7 @@ Returns what was actually sent, or nil if nothing was sent." (condition-case nil (process-send-string target object) ;; If `process-send-string' raises an error, treat it as a broken pipe. - (error (signal 'eshell-pipe-broken target)))) + (error (signal 'eshell-pipe-broken (list target))))) ((consp target) (apply (car target) object (cdr target)))) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 2f6614b5d73..a9df172e88e 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -490,8 +490,11 @@ Possible variable references are: ;; by `eshell-do-eval', which requires very ;; particular forms in order to work ;; properly. See bug#54190. - (list (function (lambda () - (delete-file ,temp)))))) + (list (function + (lambda () + (delete-file ,temp) + (when-let ((buffer (get-file-buffer ,temp))) + (kill-buffer buffer))))))) (eshell-apply-indices ,temp indices ,eshell-current-quoted))) (goto-char (1+ end))))))) ((eq (char-after) ?\() diff --git a/lisp/faces.el b/lisp/faces.el index 390ddbf606a..336078b0403 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1,6 +1,6 @@ ;;; faces.el --- Lisp faces -*- lexical-binding: t -*- -;; Copyright (C) 1992-1996, 1998-2022 Free Software Foundation, Inc. +;; Copyright (C) 1992-2022 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal @@ -583,9 +583,6 @@ with the `default' face (which is always completely specified)." nil)) -(defalias 'face-background-pixmap 'face-stipple) - - (defun face-underline-p (face &optional frame inherit) "Return non-nil if FACE specifies a non-nil underlining. If the optional argument FRAME is given, report on face FACE in that frame. @@ -1053,9 +1050,6 @@ Use `set-face-attribute' to \"unspecify\" underlining." (set-face-attribute face frame :extend extend-p)) -(defalias 'set-face-background-pixmap 'set-face-stipple) - - (defun invert-face (face &optional frame) "Swap the foreground and background colors of FACE. If FRAME is omitted or nil, it means change face on all frames. @@ -2984,7 +2978,7 @@ bindings. See also the face `tooltip'." :group 'help) (defface glyphless-char - '((((type tty)) :inherit underline) + '((((type tty)) :inherit escape-glyph :underline t) (((type pc)) :inherit escape-glyph) (t :height 0.6)) "Face for displaying non-graphic characters (e.g. U+202A (LRE)). @@ -3179,6 +3173,9 @@ also the same size as FACE on FRAME, or fail." :group 'display) (make-obsolete-variable 'font-list-limit nil "24.3") +(define-obsolete-function-alias 'face-background-pixmap #'face-stipple "29.1") +(define-obsolete-function-alias 'set-face-background-pixmap #'set-face-stipple "29.1") + (provide 'faces) ;;; faces.el ends here diff --git a/lisp/ffap.el b/lisp/ffap.el index e4017595916..88b4bce9fd1 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -948,7 +948,7 @@ out of NAME." (save-excursion (re-search-backward (regexp-opt (mapcar 'car preferred-suffix-rules)) - (point-at-bol) + (line-beginning-position) t)) (push (cons "" (cdr (assoc (match-string 0) ; i.e. "(TeX-current-macro)" preferred-suffix-rules))) @@ -962,7 +962,7 @@ out of NAME." (concat (car rule) name (cdr rule))) guess-rules))) (when (< (point-min) (point-max)) - (buffer-substring (goto-char (point-min)) (point-at-eol)))))))) + (buffer-substring (goto-char (point-min)) (line-end-position)))))))) (defun ffap-tex (name) (ffap-tex-init) diff --git a/lisp/files.el b/lisp/files.el index 05a924a363d..740e09055bb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -396,19 +396,24 @@ add a final newline, whenever you save a file that really needs one." ;; transformed to "/2" on DOS/Windows. ,(concat temporary-file-directory "\\2") t)) "Transforms to apply to buffer file name before making auto-save file name. + Each transform is a list (REGEXP REPLACEMENT UNIQUIFY): + REGEXP is a regular expression to match against the file name. If it matches, `replace-match' is used to replace the matching part with REPLACEMENT. -If the optional element UNIQUIFY is non-nil, the auto-save file name is -constructed by taking the directory part of the replaced file-name, -concatenated with the buffer file name with all directory separators -changed to `!' to prevent clashes. This will not work -correctly if your filesystem truncates the resulting name. -If UNIQUIFY is one of the members of `secure-hash-algorithms', -Emacs constructs the nondirectory part of the auto-save file name -by applying that `secure-hash' to the buffer file name. This -avoids any risk of excessively long file names. + +If the optional element UNIQUIFY is nil, Emacs does not check for +file name clashes, so using that is not recommended. If UNIQUIFY +is one of the members of `secure-hash-algorithms', Emacs +constructs the nondirectory part of the auto-save file name by +applying that `secure-hash' to the buffer file name. This avoids +any risk of excessively long file names. Finally, if UNIQUIFY is +any other value the auto-save file name is constructed by taking +the directory part of the replaced file-name, concatenated with +the buffer file name with all directory separators changed to `!' +to prevent clashes. This will not work correctly if your +filesystem truncates the resulting name. All the transforms in the list are tried, in the order they are listed. When one transform applies, its result is final; @@ -421,8 +426,13 @@ editing a remote file. On MS-DOS filesystems without long names this variable is always ignored." :group 'auto-save - :type '(repeat (list (regexp :tag "Regexp") (string :tag "Replacement") - (boolean :tag "Uniquify"))) + :type `(repeat (list (regexp :tag "Regexp") + (string :tag "Replacement") + (choice + (const :tag "Uniquify" t) + ,@(mapcar (lambda (algo) + (list 'const algo)) + (secure-hash-algorithms))))) :initialize 'custom-initialize-delay :version "21.1") @@ -841,15 +851,20 @@ resulting list of directory names. For an empty path element (i.e., a leading or trailing separator, or two adjacent separators), return nil (meaning `default-directory') as the associated list element." (when (stringp search-path) - (let ((spath (substitute-env-vars search-path))) + (let ((spath (substitute-env-vars search-path)) + (double-slash-special-p + (memq system-type '(windows-nt cygwin ms-dos)))) (mapcar (lambda (f) (if (equal "" f) nil (let ((dir (file-name-as-directory f))) ;; Previous implementation used `substitute-in-file-name' - ;; which collapse multiple "/" in front. Do the same for - ;; backward compatibility. - (if (string-match "\\`/+" dir) - (substring dir (1- (match-end 0))) dir)))) + ;; which collapses multiple "/" in front, while + ;; preserving double slash where it matters. Do + ;; the same for backward compatibility. + (if (string-match "\\`//+" dir) + (substring dir (- (match-end 0) + (if double-slash-special-p 2 1))) + dir)))) (split-string spath path-separator))))) (defun cd-absolute (dir) @@ -6617,9 +6632,14 @@ preserve markers and overlays, at the price of being slower." ;; interface, but leaving the programmatic interface the same. (interactive (list (not current-prefix-arg))) (let ((revert-buffer-in-progress-p t) - (revert-buffer-preserve-modes preserve-modes)) + (revert-buffer-preserve-modes preserve-modes) + (state (and (boundp 'read-only-mode--state) + (list read-only-mode--state)))) (funcall (or revert-buffer-function #'revert-buffer--default) - ignore-auto noconfirm))) + ignore-auto noconfirm) + (when state + (setq buffer-read-only (car state)) + (setq-local read-only-mode--state (car state))))) (defun revert-buffer--default (ignore-auto noconfirm) "Default function for `revert-buffer'. diff --git a/lisp/find-file.el b/lisp/find-file.el index 809592413dd..614ff420f25 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -189,8 +189,19 @@ filename that EXTRACT returned." (defcustom ff-other-file-alist 'cc-other-file-alist "Alist of extensions to find given the current file's extension. -This list should contain the most used extensions before the others, -since the search algorithm searches sequentially through each +The value could be an alist or a symbol whose value is an alist. +Each element of the alist has the form + + (REGEXP (EXTENSION...)) +or + (REGEXP FUNCTION) + +where REGEXP is the regular expression matching a file's extension, +EXTENSIONs is the list of literal file-name extensions to search for, +and FUNCTION is a function of one argument, the current file's name, +that returns the list of extensions to search for. +The list of extensions should contain the most used extensions before the +others, since the search algorithm searches sequentially through each directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh'). This alist should be set by the major mode." diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 7eb5a414fe3..b6f4150964d 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1572,7 +1572,7 @@ START should be at the beginning of a line." font-lock-comment-delimiter-face))) (if (looking-back (or font-lock-comment-end-skip comment-end-skip) - (point-at-bol) t) + (line-beginning-position) t) (put-text-property (match-beginning 0) (point) 'face font-lock-comment-delimiter-face)))) (< (point) end)) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index e4704b35c8d..e1c7bcb467d 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1681,7 +1681,7 @@ and that there are no duplicates." (gnus-message 1 "Overview buffer contains garbage `%s'." (buffer-substring - p (point-at-eol)))) + p (line-end-position)))) ((= cur prev-num) (or backed-up (setq backed-up (gnus-agent-backup-overview-buffer))) @@ -2687,7 +2687,7 @@ The following commands are available: (gnus-category-position-point))) (defun gnus-category-name () - (or (intern (get-text-property (point-at-bol) 'gnus-category)) + (or (intern (get-text-property (line-beginning-position) 'gnus-category)) (error "No category on the current line"))) (defun gnus-category-read () @@ -3363,7 +3363,7 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) (cl-incf nov-entries-deleted) - (let* ((from (point-at-bol)) + (let* ((from (line-beginning-position)) (to (progn (forward-line 1) (point))) (freed (- to from))) (cl-incf bytes-freed freed) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 480ebe377d7..83ba72c091f 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1930,7 +1930,7 @@ always hide." (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) (forward-line -1) (gnus-article-hide-text-type - (point-at-bol) + (line-beginning-position) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -2060,7 +2060,7 @@ always hide." (goto-char (point-min)) (when (re-search-forward (concat "^" header ":") nil t) (gnus-article-hide-text-type - (point-at-bol) + (line-beginning-position) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -2081,7 +2081,7 @@ always hide." (article-narrow-to-head) (while (not (eobp)) (cond - ((< (setq column (- (point-at-eol) (point))) + ((< (setq column (- (line-end-position) (point))) gnus-article-normalized-header-length) (end-of-line) (insert (make-string @@ -2092,7 +2092,7 @@ always hide." (progn (forward-char gnus-article-normalized-header-length) (point)) - (point-at-eol) + (line-end-position) 'invisible t)) (t ;; Do nothing. @@ -2389,7 +2389,7 @@ fill width." (end-of-line) (when (>= (current-column) width) (narrow-to-region (min (1+ (point)) (point-max)) - (point-at-bol)) + (line-beginning-position)) (let ((goback (point-marker)) (fill-column width)) (fill-paragraph nil) @@ -2446,7 +2446,7 @@ fill width." (while (and (not (bobp)) (looking-at "^[ \t]*$") (not (gnus-annotation-in-region-p - (point) (point-at-eol)))) + (point) (line-end-position)))) (forward-line -1)) (forward-line 1) (point)))))) @@ -3583,9 +3583,10 @@ possible values." 'original-date) bface (get-text-property (match-beginning 0) 'face) eface (get-text-property (match-end 0) 'face)) - (delete-region (point-at-bol) (progn - (gnus-article-forward-header) - (point))))) + (delete-region (line-beginning-position) + (progn + (gnus-article-forward-header) + (point))))) (when (and (not date) visible-date) (setq date visible-date)) @@ -4388,8 +4389,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (message-narrow-to-head) (goto-char (point-max)) (forward-line -1) - (setq bface (get-text-property (point-at-bol) 'face) - eface (get-text-property (1- (point-at-eol)) 'face)) + (setq bface (get-text-property (line-beginning-position) 'face) + eface (get-text-property (1- (line-end-position)) 'face)) (message-remove-header "X-Gnus-PGP-Verify") (if (re-search-forward "^X-PGP-Sig:" nil t) (forward-line) @@ -5925,7 +5926,7 @@ all parts." ;; Go to the displayed subpart, assuming this is ;; multipart/alternative. (setq part start - end (point-at-eol)) + end (line-end-position)) (while (and (not handle) part (< part end) @@ -6825,9 +6826,9 @@ not have a face in `gnus-article-boring-faces'." "Read article specified by message-id around point." (interactive nil gnus-article-mode) (save-excursion - (re-search-backward "[ \t]\\|^" (point-at-bol) t) - (re-search-forward "<?news:<?\\|<" (point-at-eol) t) - (if (re-search-forward "[^@ ]+@[^ \t>]+" (point-at-eol) t) + (re-search-backward "[ \t]\\|^" (line-beginning-position) t) + (re-search-forward "<?news:<?\\|<" (line-end-position) t) + (if (re-search-forward "[^@ ]+@[^ \t>]+" (line-end-position) t) (let ((msg-id (concat "<" (match-string 0) ">"))) (set-buffer gnus-summary-buffer) (gnus-summary-refer-article msg-id)) @@ -8180,7 +8181,7 @@ url is put as the `gnus-button-url' overlay property on the button." (goto-char start) (string-match "\\(?:\"\\|\\(<\\)\\)[\t ]*\\(?:url[\t ]*:[\t ]*\\)?\\'" - (buffer-substring (point-at-bol) start))) + (buffer-substring (line-beginning-position) start))) (progn (setq url (list (buffer-substring start end)) delim (if (match-beginning 1) ">" "\"")) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 4f5b9bd3422..18732218c9f 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -509,7 +509,7 @@ Optional argument SHOW means show them unconditionally." (let ((bmrk (gnus-bookmark-bmenu-bookmark))) (setq gnus-bookmark-bmenu-hidden-bookmarks (cons bmrk gnus-bookmark-bmenu-hidden-bookmarks)) - (let ((start (point-at-eol))) + (let ((start (line-end-position))) (move-to-column gnus-bookmark-bmenu-file-column t) ;; Strip off `mouse-face' from the white spaces region. (if (display-mouse-p) @@ -543,7 +543,7 @@ Optional argument SHOW means show them unconditionally." "Kill from point to end of line. If optional arg NEWLINE-TOO is non-nil, delete the newline too. Does not affect the kill ring." - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) (if (and newline-too (looking-at "\n")) (delete-char 1))) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index ee20ba3c7f0..449b73163f4 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -552,7 +552,7 @@ Returns the list of articles removed." (set-buffer cache-buf) (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") nil t) - (setq beg (point-at-bol) + (setq beg (line-beginning-position) end (progn (end-of-line) (point))) (setq beg nil)) (set-buffer nntp-server-buffer) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 3ba2bbd6fea..b4d7661d742 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -371,7 +371,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (goto-char (point-min)) (forward-line (1- number)) (when (re-search-forward gnus-cite-attribution-suffix - (point-at-eol) + (line-end-position) t) (gnus-article-add-button (match-beginning 1) (match-end 1) 'gnus-cite-toggle prefix)) @@ -756,7 +756,7 @@ See also the documentation for `gnus-article-highlight-citation'." ;; Each line. (setq begin (point) guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) - end (point-at-bol 2) + end (line-beginning-position 2) start end) (goto-char begin) ;; Ignore standard Supercite attribution prefix. @@ -1105,8 +1105,8 @@ Returns nil if there is no such line before LIMIT, t otherwise." "[\t [:alnum:]]+"))) gnus-message-max-citation-depth)) (mlist (make-list (* (1+ gnus-message-max-citation-depth) 2) nil)) - (start (point-at-bol)) - (end (point-at-eol))) + (start (line-beginning-position)) + (end (line-end-position))) (setcar mlist start) (setcar (cdr mlist) end) (setcar (nthcdr (* cdepth 2) mlist) start) diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 6028d4fcb2f..3c57d7b1124 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -327,7 +327,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields." (when (re-search-forward (concat "^" header ":") nil t) (unless (eq (char-after) ? ) (insert " ")) - (setq value (buffer-substring (point) (point-at-eol))) + (setq value (buffer-substring (point) (line-end-position))) (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value) (setq value (match-string 1 value))) (condition-case () diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 56d498cc4d3..e38deefe2aa 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -150,7 +150,7 @@ Obeys the standard process/prefix convention." (concat "^" (regexp-quote gnus-agent-target-move-group-header) ":") nil t) (skip-syntax-forward "-") - (setq move-to (buffer-substring (point) (point-at-eol))) + (setq move-to (buffer-substring (point) (line-end-position))) (message-remove-header gnus-agent-target-move-group-header)) (goto-char (point-min)) (when (re-search-forward diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index a6b6c4a6cda..fcad601d0c3 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1204,7 +1204,7 @@ case interactively), the level will be updated by this command." (gnus-group-setup-buffer) (gnus-update-format-specifications nil 'group 'group-mode) (let ((case-fold-search nil) - (props (text-properties-at (point-at-bol))) + (props (text-properties-at (line-beginning-position))) (empty (= (point-min) (point-max))) (group (gnus-group-group-name)) number) @@ -1724,24 +1724,24 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." (defun gnus-group-group-name () "Get the name of the newsgroup on the current line." - (let ((group (get-text-property (point-at-bol) 'gnus-group))) + (let ((group (get-text-property (line-beginning-position) 'gnus-group))) (cond ((stringp group) group) (group (symbol-name group))))) (defun gnus-group-group-level () "Get the level of the newsgroup on the current line." - (get-text-property (point-at-bol) 'gnus-level)) + (get-text-property (line-beginning-position) 'gnus-level)) (defun gnus-group-group-indentation () "Get the indentation of the newsgroup on the current line." - (or (get-text-property (point-at-bol) 'gnus-indentation) + (or (get-text-property (line-beginning-position) 'gnus-indentation) (and gnus-group-indentation-function (funcall gnus-group-indentation-function)) "")) (defun gnus-group-group-unread () "Get the number of unread articles of the newsgroup on the current line." - (get-text-property (point-at-bol) 'gnus-unread)) + (get-text-property (line-beginning-position) 'gnus-unread)) (defun gnus-group-new-mail (group) (if (nnmail-new-mail-p group) @@ -2095,14 +2095,14 @@ be permanent." (looking-at "[][\C-@-*,/;-@\\^`{-\C-?]"))) (prog1 t (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" - (point-at-bol)))) + (line-beginning-position)))) (and (looking-at "[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*$") (prog1 t (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?") (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" - (point-at-bol)))) + (line-beginning-position)))) (string-match "\\`[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*\\'" - (buffer-substring (point-at-bol) (point)))) + (buffer-substring (line-beginning-position) (point)))) (when (looking-at regexp) (match-string 1)) (let (group distance) @@ -2111,7 +2111,7 @@ be permanent." distance (- (match-beginning 1) (match-beginning 0)))) (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?") (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" - (point-at-bol)) + (line-beginning-position)) (if (looking-at regexp) (if (and group (<= distance (- start (match-end 0)))) group @@ -3948,10 +3948,10 @@ The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." (count-lines (progn (goto-char begin) - (point-at-bol)) + (line-beginning-position)) (progn (goto-char end) - (point-at-bol)))))) + (line-beginning-position)))))) (goto-char begin) (beginning-of-line) ;Important when LINES < 1 (gnus-group-kill-group lines))) diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index d0edf2cba85..012ac9d556f 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -220,13 +220,13 @@ replacement is added." (error 0))) spec))) (when (> len 0) - (goto-char (point-at-eol)) + (goto-char (line-end-position)) (insert (propertize " " 'display (cons 'space (list :align-to (- (window-width) 1 len)))))) - (goto-char (point-at-eol)) - (setq point (point-at-eol)) + (goto-char (line-end-position)) + (setq point (line-end-position)) (dolist (image spec) (unless (stringp image) (goto-char point) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 4ef2ebf1dd7..6b7958dcb91 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -686,7 +686,7 @@ it in the environment specified by BINDINGS." (unless (zerop level) (gnus-tree-indent level) (insert (cadr gnus-tree-parent-child-edges)) - (setq col (- (setq beg (point)) (point-at-bol) 1)) + (setq col (- (setq beg (point)) (line-beginning-position) 1)) ;; Draw "|" lines upwards. (while (progn (forward-line -1) @@ -710,7 +710,7 @@ it in the environment specified by BINDINGS." (defsubst gnus-tree-indent-vertical () (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) - (- (point) (point-at-bol))))) + (- (point) (line-beginning-position))))) (when (> len 0) (insert (make-string len ? ))))) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index c852986ae61..5f49c280072 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1168,9 +1168,9 @@ If FORMAT, also format the current score file." (reg " -> +") (file (save-excursion (end-of-line) - (if (and (re-search-backward reg (point-at-bol) t) - (re-search-forward reg (point-at-eol) t)) - (buffer-substring (point) (point-at-eol)) + (if (and (re-search-backward reg (line-beginning-position) t) + (re-search-forward reg (line-end-position) t)) + (buffer-substring (point) (line-end-position)) nil)))) (if (or (not file) (string-match "\\<\\(non-file rule\\|A file\\)\\>" file) @@ -1999,7 +1999,7 @@ score in `gnus-newsgroup-scored' by SCORE." (goto-char (point-min)) (if (= dmt ?e) (while (funcall search-func match nil t) - (and (= (point-at-bol) + (and (= (line-beginning-position) (match-beginning 0)) (= (progn (end-of-line) (point)) (match-end 0)) @@ -2170,7 +2170,7 @@ score in `gnus-newsgroup-scored' by SCORE." (funcall search-func match nil t)) ;; Is it really exact? (and (eolp) - (= (point-at-bol) (match-beginning 0)) + (= (line-beginning-position) (match-beginning 0)) ;; Yup. (progn (setq found (setq arts (get-text-property @@ -2260,7 +2260,7 @@ score in `gnus-newsgroup-scored' by SCORE." (goto-char (point-min)) (while (and (not (eobp)) (search-forward match nil t)) - (when (and (= (point-at-bol) (match-beginning 0)) + (when (and (= (line-beginning-position) (match-beginning 0)) (eolp)) (setq found (setq arts (get-text-property (point) 'articles))) (if trace @@ -2344,7 +2344,7 @@ score in `gnus-newsgroup-scored' by SCORE." hashtb)) (puthash word - (append (get-text-property (point-at-eol) 'articles) val) + (append (get-text-property (line-end-position) 'articles) val) hashtb))) ;; Make all the ignorable words ignored. (let ((ignored (append gnus-ignored-adaptive-words diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 53b6d1b4c6f..327dba95c07 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -565,7 +565,7 @@ returning the one at the supplied position." (buffer-substring (point) (progn - (re-search-forward ":" (point-at-eol) t) + (re-search-forward ":" (line-end-position) t) (1- (point)))))) (value (gnus-search-query-return-string (when (looking-at-p "[\"/]") t)))) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 54be0f8e6a0..e659a648e10 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -339,13 +339,13 @@ The following commands are available: (gnus-server-position-point)) (defun gnus-server-server-name () - (let ((server (get-text-property (point-at-bol) 'gnus-server))) + (let ((server (get-text-property (line-beginning-position) 'gnus-server))) (and server (symbol-name server)))) (defun gnus-server-named-server () "Return a server name that matches one of the names returned by `gnus-method-to-server'." - (let ((server (get-text-property (point-at-bol) 'gnus-named-server))) + (let ((server (get-text-property (line-beginning-position) 'gnus-named-server))) (and server (symbol-name server)))) (defalias 'gnus-server-position-point 'gnus-goto-colon) @@ -949,7 +949,7 @@ how new groups will be entered into the group buffer." (save-excursion (beginning-of-line) (let ((name (get-text-property (point) 'gnus-group))) - (when (re-search-forward ": \\(.*\\)$" (point-at-eol) t) + (when (re-search-forward ": \\(.*\\)$" (line-end-position) t) (concat (gnus-method-to-server-name gnus-browse-current-method) ":" (or name (match-string-no-properties 1))))))) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 7b5721fafbb..7700e6bd430 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -855,7 +855,7 @@ If REGEXP is given, lines that match it will be deleted." (unless (bolp) (forward-line 1)) (setq end (point)) (goto-char (match-beginning 0)) - (delete-region (point-at-bol) end)))) + (delete-region (line-beginning-position) end)))) (goto-char (point-max)) ;; Make sure that each dribble entry is a single line, so that ;; the "remove" code above works. @@ -2173,7 +2173,7 @@ The info element is shared with the same element of (unless ignore-errors (gnus-message 3 "Warning - invalid active: %s" (buffer-substring - (point-at-bol) (point-at-eol)))))) + (line-beginning-position) (line-end-position)))))) (forward-line 1))))) (defun gnus-groups-to-gnus-format (method &optional hashtb real-active) @@ -2527,10 +2527,10 @@ The form should return either t or nil." ;; don't give a damn, frankly, my dear. (concat gnus-newsrc-options (buffer-substring - (point-at-bol) + (line-beginning-position) ;; Options may continue on the next line. (or (and (re-search-forward "^[^ \t]" nil 'move) - (point-at-bol)) + (line-beginning-position)) (point))))) (forward-line -1)) (group @@ -2592,8 +2592,8 @@ The form should return either t or nil." ;; The line was buggy. (setq group nil) (gnus-error 3.1 "Mangled line: %s" - (buffer-substring (point-at-bol) - (point-at-eol)))) + (buffer-substring (line-beginning-position) + (line-end-position)))) nil)) ;; Skip past ", ". Spaces are invalid in these ranges, but ;; we allow them, because it's a common mistake to put a @@ -2702,9 +2702,9 @@ The form should return either t or nil." (while (re-search-forward "[ \t]-n" nil t) (setq eol (or (save-excursion - (and (re-search-forward "[ \t]-n" (point-at-eol) t) + (and (re-search-forward "[ \t]-n" (line-end-position) t) (- (point) 2))) - (point-at-eol))) + (line-end-position))) ;; Search for all "words"... (while (re-search-forward "[^ \t,\n]+" eol t) (if (eq (char-after (match-beginning 0)) ?!) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 90b57695c57..dde60caee7e 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3383,7 +3383,7 @@ marks of articles." (let (config) (goto-char (point-min)) (while (not (eobp)) - (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum) + (when (eq (get-char-property (line-end-position) 'invisible) 'gnus-sum) (push (save-excursion (forward-line 0) (point)) config)) (forward-line 1)) config))) @@ -4505,7 +4505,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let (header) ;; overview: [num subject from date id refs chars lines misc] (unwind-protect - (narrow-to-region (point) (point-at-eol)) + (narrow-to-region (point) (line-end-position)) (unless (eobp) (forward-char)) (setq header (nnheader-parse-nov number)) @@ -4661,7 +4661,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (setq thread (list (car (gnus-id-to-thread id)))) ;; Get the thread this article is part of. (setq thread (gnus-remove-thread id))) - (setq old-pos (point-at-bol)) + (setq old-pos (line-beginning-position)) (setq current (save-excursion (and (re-search-backward "[\r\n]" nil t) (gnus-summary-article-number)))) @@ -4845,9 +4845,9 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-summary-show-thread) (gnus-data-remove number - (- (point-at-bol) + (- (line-beginning-position) (prog1 - (1+ (point-at-eol)) + (1+ (line-end-position)) (gnus-delete-line))))))) (defun gnus-sort-threads-recursive (threads func) @@ -6468,7 +6468,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) (point-at-eol))) + (setq xref (buffer-substring (point) (line-end-position))) (setf (mail-header-xref headers) xref))))))) (defun gnus-summary-insert-subject (id &optional old-header use-old-header) @@ -6499,9 +6499,9 @@ too, instead of trying to fetch new headers." (goto-char (gnus-data-pos d)) (gnus-data-remove number - (- (point-at-bol) + (- (line-beginning-position) (prog1 - (1+ (point-at-eol)) + (1+ (line-end-position)) (gnus-delete-line)))))) ;; Remove list identifiers from subject. (let ((gnus-newsgroup-headers (list header))) @@ -11219,7 +11219,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (defun gnus-summary-update-mark (mark type) (let ((forward (cdr (assq type gnus-summary-mark-positions))) (inhibit-read-only t)) - (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit) + (re-search-backward "[\n\r]" (line-beginning-position) 'move-to-limit) (when forward (when (looking-at "\r") (cl-incf forward)) @@ -11756,7 +11756,7 @@ If ARG is positive number, turn showing conversation threads on." Returns nil if no thread was there to be shown." (interactive nil gnus-summary-mode) (let* ((orig (point)) - (end (point-at-eol)) + (end (line-end-position)) (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end)))) ;; Leave point at bol (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point))))) @@ -12675,8 +12675,8 @@ If REVERSE, save parts that do not match TYPE." ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. (when gnus-summary-selected-face (save-excursion - (let* ((beg (point-at-bol)) - (end (point-at-eol)) + (let* ((beg (line-beginning-position)) + (end (line-end-position)) ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>. (from (if (get-text-property beg 'mouse-face) beg @@ -12732,7 +12732,7 @@ If REVERSE, save parts that do not match TYPE." (with-no-warnings ;See docstring of gnus-summary-highlight. (defvar score) (defvar default) (defvar default-high) (defvar default-low) (defvar mark) (defvar uncached)) - (let* ((beg (point-at-bol)) + (let* ((beg (line-beginning-position)) (article (or (gnus-summary-article-number) gnus-current-article)) (score (or (cdr (assq article gnus-newsgroup-scored)) @@ -12748,7 +12748,7 @@ If REVERSE, save parts that do not match TYPE." (let ((face (funcall (gnus-summary-highlight-line-0)))) (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (gnus-put-text-property-excluding-characters-with-faces - beg (1+ (point-at-eol)) 'face + beg (1+ (line-end-position)) 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function (funcall gnus-summary-highlight-line-function article face)))))) @@ -12895,7 +12895,7 @@ treated as multipart/mixed." (insert "Mime-Version: 1.0\n") (widen) (when (search-forward "\n--" nil t) - (let ((separator (buffer-substring (point) (point-at-eol)))) + (let ((separator (buffer-substring (point) (line-end-position)))) (message-narrow-to-head) (message-remove-header "Content-Type") (goto-char (point-max)) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index fa942bee8e8..13263dddc9c 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -107,15 +107,15 @@ should return non-nil if the topic is to be displayed." (defun gnus-group-topic-name () "The name of the topic on the current line." - (get-text-property (point-at-bol) 'gnus-topic)) + (get-text-property (line-beginning-position) 'gnus-topic)) (defun gnus-group-topic-level () "The level of the topic on the current line." - (get-text-property (point-at-bol) 'gnus-topic-level)) + (get-text-property (line-beginning-position) 'gnus-topic-level)) (defun gnus-group-topic-unread () "The number of unread articles in topic on the current line." - (get-text-property (point-at-bol) 'gnus-topic-unread)) + (get-text-property (line-beginning-position) 'gnus-topic-unread)) (defun gnus-topic-unread (topic) "Return the number of unread articles in TOPIC." @@ -128,7 +128,7 @@ should return non-nil if the topic is to be displayed." (defun gnus-topic-visible-p () "Return non-nil if the current topic is visible." - (get-text-property (point-at-bol) 'gnus-topic-visible)) + (get-text-property (line-beginning-position) 'gnus-topic-visible)) (defun gnus-topic-articles-in-topic (entries) (let ((total 0) @@ -188,7 +188,7 @@ If TOPIC, start with that topic." (defun gnus-group-active-topic-p () "Say whether the current topic comes from the active topics." - (get-text-property (point-at-bol) 'gnus-active)) + (get-text-property (line-beginning-position) 'gnus-active)) (defun gnus-topic-find-groups (topic &optional level all lowest recursive) "Return entries for all visible groups in TOPIC. diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 4c93814e0dc..fe556b155a8 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -118,7 +118,7 @@ This is a compatibility function for different Emacsen." ;; Delete the current line (and the next N lines). (defmacro gnus-delete-line (&optional n) - `(delete-region (point-at-bol) + `(delete-region (line-beginning-position) (progn (forward-line ,(or n 1)) (point)))) (defun gnus-extract-address-components (from) @@ -178,7 +178,7 @@ is slower." (defun gnus-goto-colon () (move-beginning-of-line 1) - (let ((eol (point-at-eol))) + (let ((eol (line-end-position))) (goto-char (or (text-property-any (point) eol 'gnus-position t) (search-forward ":" eol t) (point))))) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index ee6cab365f3..9cafc78ab89 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -544,11 +544,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "Various")))) (goto-char (point-min)) (when (re-search-forward "^Subject: ") - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) (insert subject)) (goto-char (point-min)) (when (re-search-forward "^From:") - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) (insert " " from)) (let ((message-forward-decoded-p t)) (message-forward post t)))) @@ -1763,7 +1763,7 @@ Gnus might fail to display all of it.") (unless (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string)) (when (not found) - (setq length (- (point-at-eol) (point-at-bol)))) + (setq length (- (line-end-position) (line-beginning-position)))) (setq found t) (beginning-of-line) (setq beg (point)) @@ -2068,7 +2068,7 @@ If no file has been included, the user will be asked for a file." (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (setq header (buffer-substring (point-min) (point-at-bol))) + (setq header (buffer-substring (point-min) (line-beginning-position))) (goto-char (point-min)) (when gnus-uu-post-separate-description diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index da05a768e3b..49a04f601f8 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2185,7 +2185,7 @@ see `message-narrow-to-headers-or-head'." (progn (forward-line 1) (if (re-search-forward "^[^ \n\t]" nil t) - (point-at-bol) + (line-beginning-position) (point-max)))) (goto-char (point-min))) @@ -3664,7 +3664,7 @@ Message buffers and is not meant to be called directly." (save-excursion (save-restriction (widen) - (let ((bound (+ (point-at-eol) 1)) case-fold-search) + (let ((bound (+ (line-end-position) 1)) case-fold-search) (goto-char (point-min)) (not (search-forward (concat "\n" mail-header-separator "\n") bound t)))))) @@ -3928,8 +3928,7 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line." (if all-removed (goto-char start) (forward-line 1)))) - ;; Delete blank lines at the start of the buffer. - (goto-char (point-min)) + ;; Delete blank lines at the start of the cited text. (while (and (eolp) (not (eobp))) (delete-line)) ;; Delete blank lines at the end of the buffer. @@ -5671,11 +5670,11 @@ Otherwise, generate and save a value for `canlock-password' first." (goto-char (point-max)) (if (not (re-search-backward message-signature-separator nil t)) t - (setq sig-start (1+ (point-at-eol))) + (setq sig-start (1+ (line-end-position))) (setq sig-end (if (re-search-forward "<#/?\\(multipart\\|part\\|external\\|mml\\)" nil t) - (- (point-at-bol) 1) + (- (line-beginning-position) 1) (point-max))) (if (>= (count-lines sig-start sig-end) 5) (if (message-gnksa-enable-p 'signature) @@ -6361,7 +6360,7 @@ Headers already prepared in the buffer are not modified." (forward-line -1))) ;; The value of this header was empty, so we clear ;; totally and insert the new value. - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) ;; If the header is optional, and the header was ;; empty, we can't insert it anyway. (unless optionalp @@ -6616,10 +6615,10 @@ beginning of a folded header)." (or (eq (char-after) ?\s) (eq (char-after) ?\t))) (beginning-of-line 0))) (when (or (eq (char-after) ?\s) (eq (char-after) ?\t) - (search-forward ":" (point-at-eol) t)) + (search-forward ":" (line-end-position) t)) ;; We are a bit more lacks than the RFC and allow any positive number of WSP ;; characters. - (skip-chars-forward " \t" (point-at-eol)) + (skip-chars-forward " \t" (line-end-position)) (point))) (defun message-beginning-of-line (&optional n) @@ -8642,7 +8641,7 @@ From headers in the original article." (autoload 'ecomplete-display-matches "ecomplete") (defun message--in-tocc-p () - (and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? )) + (and (memq (char-after (line-beginning-position)) '(?C ?T ?\t ? )) (message-point-in-header-p) (save-excursion (beginning-of-line) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 1417ecdccc8..5268f192c61 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -117,7 +117,8 @@ (cond ((fboundp 'libxml-parse-html-region) 'shr) ((executable-find "w3m") 'gnus-w3m) ((executable-find "links") 'links) - ((executable-find "lynx") 'lynx)) + ((executable-find "lynx") 'lynx) + (t 'shr)) "Render of HTML contents. It is one of defined renderer types, or a rendering function. The defined renderer types are: diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 5f9903a5b06..1a699d0e705 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -307,7 +307,7 @@ (while (re-search-forward "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (point-at-bol) (progn (forward-line 1) (point)))) + (delete-region (line-beginning-position) (progn (forward-line 1) (point)))) (setq result (eval accept-form t)) (kill-buffer (current-buffer)) result) @@ -424,7 +424,7 @@ (defun nnbabyl-delete-mail (&optional force leave-delim) ;; Delete the current X-Gnus-Newsgroup line. (unless force - (delete-region (point-at-bol) (progn (forward-line 1) (point)))) + (delete-region (line-beginning-position) (progn (forward-line 1) (point)))) ;; Beginning of the article. (save-excursion (save-restriction @@ -630,7 +630,8 @@ (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) (if (gethash (setq id (match-string 1)) idents) (progn - (delete-region (point-at-bol) (progn (forward-line 1) (point))) + (delete-region (line-beginning-position) + (progn (forward-line 1) (point))) (nnheader-message 7 "Moving %s..." id) (nnbabyl-save-mail (nnmail-article-group 'nnbabyl-active-number))) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 14540ac7e87..27204b3618a 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -862,7 +862,7 @@ all. This may very well take some time.") (search-forward id nil t)) ; We find the ID. ;; And the id is in the fourth field. (if (not (and (search-backward "\t" nil t 4) - (not (search-backward"\t" (point-at-bol) t)))) + (not (search-backward"\t" (line-beginning-position) t)))) (forward-line 1) (beginning-of-line) (setq found t) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index a2b461c15f0..c47a398c4c2 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -179,7 +179,7 @@ all. This may very well take some time.") (goto-char (match-end 0)) (setq num (string-to-number (buffer-substring - (point) (point-at-eol)))) + (point) (line-end-position)))) (goto-char start) (< num article))) ;; Check that we are before an article with a @@ -189,7 +189,7 @@ all. This may very well take some time.") (progn (setq num (string-to-number (buffer-substring - (point) (point-at-eol)))) + (point) (line-end-position)))) (> num article)) ;; Discard any article numbers before the one we're ;; now looking at. @@ -259,7 +259,7 @@ all. This may very well take some time.") (if (search-forward (concat "\n" nnfolder-article-marker) nil t) (string-to-number (buffer-substring - (point) (point-at-eol))) + (point) (line-end-position))) -1)))))))) (deffoo nnfolder-request-group (group &optional server dont-check _info) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 634cc251b87..b91798b8a0c 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -188,7 +188,7 @@ on your system, you could say something like: (defsubst nnheader-header-value () (skip-chars-forward " \t") - (buffer-substring (point) (point-at-eol))) + (buffer-substring (point) (line-end-position))) (autoload 'ietf-drums-unfold-fws "ietf-drums") @@ -397,7 +397,7 @@ leaving the original buffer untouched." (autoload 'gnus-extract-message-id-from-in-reply-to "gnus-sum") (defun nnheader-parse-nov (&optional number) - (let ((eol (point-at-eol)) + (let ((eol (line-end-position)) references in-reply-to x header) (setq header (make-full-mail-header @@ -632,7 +632,7 @@ the line could be found." ;; This is invalid, but not all articles have Message-IDs. () (mail-position-on-field "References") - (let ((begin (point-at-bol)) + (let ((begin (line-beginning-position)) (fill-column 78) (fill-prefix "\t")) (when references diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index bde0de98924..afa14448fc7 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -661,7 +661,7 @@ nn*-request-list should have been called before calling this function." (while (not (eobp)) (condition-case nil (progn - (narrow-to-region (point) (point-at-eol)) + (narrow-to-region (point) (line-end-position)) (setq group (read buffer) group (cond ((symbolp group) @@ -1116,7 +1116,7 @@ FUNC will be called with the group name to determine the article number." (while (not (eobp)) (unless (< (move-to-column nnmail-split-header-length-limit) nnmail-split-header-length-limit) - (delete-region (point) (point-at-eol))) + (delete-region (point) (line-end-position))) (forward-line 1)) ;; Allow washing. (goto-char (point-min)) @@ -1650,7 +1650,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (skip-chars-forward "^\n\r\t") (unless (looking-at "[\r\n]") (forward-char 1) - (buffer-substring (point) (point-at-eol))))))) + (buffer-substring (point) (line-end-position))))))) ;; Function for nnmail-split-fancy: look up all references in the ;; cache and if a match is found, return that group. diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 8c811b0c6c0..b1eee2d5308 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -574,7 +574,7 @@ Other back ends might or might not work.") (gnus-group-get-parameter qualgroup 'folder))) (progn (replace-match cur) - (delete-region cpoint (point-at-bol)) + (delete-region cpoint (line-beginning-position)) (forward-line) (setq cpoint (point))) (forward-line))) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index ae726ba0f7b..40e4b9ea828 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -601,7 +601,7 @@ non-nil.") (search-forward id nil t)) ; We find the ID. ;; And the id is in the fourth field. (if (not (and (search-backward "\t" nil t 4) - (not (search-backward "\t" (point-at-bol) t)))) + (not (search-backward "\t" (line-beginning-position) t)))) (forward-line 1) (beginning-of-line) (setq found t) @@ -755,7 +755,7 @@ article number. This function is called narrowed to an article." (nnheader-insert-nov headers))) (defsubst nnml-header-value () - (buffer-substring (match-end 0) (point-at-eol))) + (buffer-substring (match-end 0) (line-end-position))) (defun nnml-parse-head (chars &optional number) "Parse the head of the current buffer." @@ -1061,7 +1061,7 @@ Use the nov database for the current group if available." (regexp-quote (concat group ":" old-number-string)) "\\>") - (point-at-eol) t)) + (line-end-position) t)) (replace-match (concat group ":" new-number-string))) ;; Save to the new file: @@ -1109,7 +1109,7 @@ Use the nov database for the current group if available." (regexp-quote (concat group ":" old-number-string)) "\\>") - (point-at-eol) t) + (line-end-position) t) (replace-match (concat "\\1" group ":" new-number-string)))))) ;; 4/ Possibly remove the article from the backlog: diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 6fa424a1555..6dea405d02b 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -480,7 +480,7 @@ retried once before actually displaying the error report." (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) - (point-at-bol))))))) + (line-beginning-position))))))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -503,7 +503,7 @@ retried once before actually displaying the error report." (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) - (point-at-bol))))))) + (line-beginning-position))))))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -528,7 +528,8 @@ retried once before actually displaying the error report." (with-current-buffer buffer (goto-char pos) (if (looking-at (regexp-quote command)) - (delete-region pos (progn (forward-line 1) (point-at-bol)))) + (delete-region pos (progn (forward-line 1) + (line-beginning-position)))) ))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 7b192aa1d2e..e150cbf2b46 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -387,7 +387,7 @@ lines have the correct component server prefix." (looking-at "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") (goto-char (match-end 0)) - (unless (search-forward "\t" (point-at-eol) 'move) + (unless (search-forward "\t" (line-end-position) 'move) (insert "\t")) ;; Remove any spaces at the beginning of the Xref field. @@ -403,8 +403,8 @@ lines have the correct component server prefix." ;; component server prefix. (save-restriction (narrow-to-region (point) - (or (search-forward "\t" (point-at-eol) t) - (point-at-eol))) + (or (search-forward "\t" (line-end-position) t) + (line-end-position))) (goto-char (point-min)) (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t) (replace-match "" t t)) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 87b5551d31c..fd2791f5c51 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -519,7 +519,7 @@ A string or a list of strings is returned." (goto-char b) (let (res) (while (< (point) e) - (let ((str (buffer-substring (point) (point-at-eol)))) + (let ((str (buffer-substring (point) (line-end-position)))) (unless (string= "" str) (push str res))) (forward-line)) diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 334204768b4..014b8254fa0 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -291,7 +291,7 @@ symbol `ask', query before flushing the queue file." (goto-char (point-min)) (while (and (not (eobp)) (re-search-forward - "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t)) + "http://\\([^/]+\\)\\(/.*\\) *$" (line-end-position) t)) (let ((spam-report-gmane-wait (zerop (% (line-number-at-pos) spam-report-gmane-max-requests)))) (gnus-message 6 "Reporting %s%s..." diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 2883a6186bd..e0d90e5547a 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -2132,7 +2132,7 @@ See `spam-ifile-database'." ;; check the return now (we're back in the temp buffer) (goto-char (point-min)) (if (not (eobp)) - (setq category (buffer-substring (point) (point-at-eol)))) + (setq category (buffer-substring (point) (line-end-position)))) (when (not (zerop (length category))) ; we need a category here (if spam-ifile-all-categories (setq return category) @@ -2321,7 +2321,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (with-temp-buffer (insert-file-contents file) (while (not (eobp)) - (setq address (buffer-substring (point) (point-at-eol))) + (setq address (buffer-substring (point) (line-end-position))) (forward-line 1) ;; insert the e-mail address if detected, otherwise the raw data (unless (zerop (length address)) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 74e18285e64..1ccf9bb4281 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1155,6 +1155,17 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (add-hook 'help-fns-describe-function-functions #'help-fns--parent-mode) (add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro 100) +(defun help-fns--generalized-variable (function) + (when (and (get function 'gv-expander) + ;; Don't mention obsolete generalized variables. + (not (get function 'byte-obsolete-generalized-variable))) + (insert (format-message " `%s' is also a " function) + (buttonize "generalized variable" + (lambda (_) (info "(elisp)Generalized Variables"))) + ".\n"))) +(add-hook 'help-fns-describe-function-functions + #'help-fns--generalized-variable) + ;; Variables diff --git a/lisp/help.el b/lisp/help.el index 37aab15df05..15ab3192ad7 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -566,13 +566,16 @@ To record all your input, use `open-dribble-file'." ;; Key bindings (defun help--key-description-fontified (keys &optional prefix) - "Like `key-description' but add face for \"*Help*\" buffers." - ;; We add both the `font-lock-face' and `face' properties here, as this - ;; seems to be the only way to get this to work reliably in any - ;; buffer. - (propertize (key-description keys prefix) - 'font-lock-face 'help-key-binding - 'face 'help-key-binding)) + "Like `key-description' but add face for \"*Help*\" buffers. +KEYS is the return value of `(where-is-internal \\='foo-cmd nil t)'. +Return nil if KEYS is nil." + (when keys + ;; We add both the `font-lock-face' and `face' properties here, as this + ;; seems to be the only way to get this to work reliably in any + ;; buffer. + (propertize (key-description keys prefix) + 'font-lock-face 'help-key-binding + 'face 'help-key-binding))) (defcustom describe-bindings-outline t "Non-nil enables outlines in the output buffer of `describe-bindings'." diff --git a/lisp/ido.el b/lisp/ido.el index 134081d6759..520513b1d29 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -3966,7 +3966,7 @@ If `ido-change-word-sub' cannot be found in WORD, return nil." (if (and (eq last-command this-command) temp-buf) ;; scroll buffer (let (win (buf (current-buffer))) - (display-buffer temp-buf nil nil) + (display-buffer temp-buf) (set-buffer temp-buf) (setq win (get-buffer-window temp-buf)) (if (pos-visible-in-window-p (point-max) win) @@ -3981,7 +3981,10 @@ If `ido-change-word-sub' cannot be found in WORD, return nil." (set-buffer buf)) (setq display-it t)) (if (and ido-completion-buffer display-it) - (with-output-to-temp-buffer ido-completion-buffer + (with-temp-buffer-window ido-completion-buffer + '((display-buffer-reuse-window display-buffer-at-bottom) + (window-height . fit-window-to-buffer)) + nil (let* ((comps (cond (ido-directory-too-big diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 93cce33c2ba..9f12354111c 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1978,8 +1978,8 @@ based on `image-mode'." (cur-win (selected-window))) (when buf (kill-buffer buf)) - (when-let ((buf (find-file-other-window file))) - (display-buffer buf) + (when-let ((buf (find-file-noselect file nil t))) + (pop-to-buffer buf) (rename-buffer image-dired-display-image-buffer) (image-dired-display-image-mode) (select-window cur-win)))) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 46c555df278..9485f1e0060 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -23,10 +23,14 @@ ;;; Commentary: -;; Defines a major mode for visiting image files -;; that allows conversion between viewing the text of the file, -;; hex of the file and viewing the file as an image. Viewing the image -;; works by putting a `display' text-property on the +;; Defines `image-mode', a major mode for visiting image files. Displaying +;; images only works if Emacs was built with support for displaying +;; such images. See Info node `(emacs) Image Mode' for more +;; information. +;; +;; There is support for switching between viewing the text of the +;; file, the hex of the file and viewing the file as an image. +;; Viewing the image works by putting a `display' text-property on the ;; image data, with the image-data still present underneath; if the ;; resulting buffer file is saved to another name it will correctly save ;; the image data to the new file. @@ -238,7 +242,7 @@ image." (defun image-forward-hscroll (&optional n) "Scroll image in current window to the left by N character widths. Stop if the right edge of the image is reached." - (interactive "p") + (interactive "p" image-mode) (cond ((= n 0) nil) ((< n 0) (image-set-window-hscroll (max 0 (+ (window-hscroll) n)))) @@ -253,13 +257,13 @@ Stop if the right edge of the image is reached." (defun image-backward-hscroll (&optional n) "Scroll image in current window to the right by N character widths. Stop if the left edge of the image is reached." - (interactive "p") + (interactive "p" image-mode) (image-forward-hscroll (- n))) (defun image-next-line (n) "Scroll image in current window upward by N lines. Stop if the bottom edge of the image is reached." - (interactive "p") + (interactive "p" image-mode) ;; Convert N to pixels. (setq n (* n (frame-char-height))) (cond ((= n 0) nil) @@ -276,7 +280,7 @@ Stop if the bottom edge of the image is reached." (defun image-previous-line (&optional n) "Scroll image in current window downward by N lines. Stop if the top edge of the image is reached." - (interactive "p") + (interactive "p" image-mode) (image-next-line (- n))) (defun image-scroll-up (&optional n) @@ -294,7 +298,7 @@ A negative N means scroll downward. If N is the atom `-', scroll downward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'." - (interactive "P") + (interactive "P" image-mode) (cond ((null n) (let* ((edges (window-inside-edges)) (win-height (- (nth 3 edges) (nth 1 edges)))) @@ -322,7 +326,7 @@ A negative N means scroll upward. If N is the atom `-', scroll upward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'." - (interactive "P") + (interactive "P" image-mode) (cond ((null n) (let* ((edges (window-inside-edges)) (win-height (- (nth 3 edges) (nth 1 edges)))) @@ -343,7 +347,7 @@ A near full screen is 2 columns less than a full screen. Negative ARG means scroll rightward. If ARG is the atom `-', scroll rightward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'." - (interactive "P") + (interactive "P" image-mode) (cond ((null n) (let* ((edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges)))) @@ -364,7 +368,7 @@ A near full screen is 2 less than a full screen. Negative ARG means scroll leftward. If ARG is the atom `-', scroll leftward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'." - (interactive "P") + (interactive "P" image-mode) (cond ((null n) (let* ((edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges)))) @@ -381,7 +385,7 @@ When calling from a program, supply as argument a number, nil, or `-'." "Scroll horizontally to the left edge of the image in the current window. With argument ARG not nil or 1, move forward ARG - 1 lines first, stopping if the top or bottom edge of the image is reached." - (interactive "p") + (interactive "p" image-mode) (and arg (/= (setq arg (prefix-numeric-value arg)) 1) (image-next-line (- arg 1))) @@ -391,7 +395,7 @@ stopping if the top or bottom edge of the image is reached." "Scroll horizontally to the right edge of the image in the current window. With argument ARG not nil or 1, move forward ARG - 1 lines first, stopping if the top or bottom edge of the image is reached." - (interactive "p") + (interactive "p" image-mode) (and arg (/= (setq arg (prefix-numeric-value arg)) 1) (image-next-line (- arg 1))) @@ -403,13 +407,13 @@ stopping if the top or bottom edge of the image is reached." (defun image-bob () "Scroll to the top-left corner of the image in the current window." - (interactive) + (interactive nil image-mode) (image-set-window-hscroll 0) (image-set-window-vscroll 0)) (defun image-eob () "Scroll to the bottom-right corner of the image in the current window." - (interactive) + (interactive nil image-mode) (let* ((image (image-get-display-property)) (edges (window-inside-edges)) (pixel-edges (window-edges nil t t)) @@ -431,7 +435,7 @@ If called interactively, or if TOGGLE is non-nil, toggle between fitting FRAME to the current image and restoring the size and window configuration prior to the last `image-mode-fit-frame' call." - (interactive (list nil t)) + (interactive (list nil t) image-mode) (let* ((buffer (current-buffer)) (saved (frame-parameter frame 'image-mode-saved-params)) (window-configuration (current-window-configuration frame)) @@ -476,156 +480,156 @@ image as text, when opening such images in `image-mode'." (defvar-local image-multi-frame nil "Non-nil if image for the current Image mode buffer has multiple frames.") -(defvar image-mode-map - (let ((map (make-sparse-keymap))) - - ;; Toggling keys - (define-key map "\C-c\C-c" 'image-toggle-display) - (define-key map "\C-c\C-x" 'image-toggle-hex-display) - - ;; Transformation keys - (define-key map "sf" 'image-mode-fit-frame) - (define-key map "sw" 'image-transform-fit-to-window) - (define-key map "sh" 'image-transform-fit-to-height) - (define-key map "si" 'image-transform-fit-to-width) - (define-key map "sb" 'image-transform-fit-both) - (define-key map "ss" 'image-transform-set-scale) - (define-key map "sr" 'image-transform-set-rotation) - (define-key map "sm" 'image-transform-set-smoothing) - (define-key map "so" 'image-transform-original) - (define-key map "s0" 'image-transform-reset) - - ;; Multi-frame keys - (define-key map (kbd "RET") 'image-toggle-animation) - (define-key map "F" 'image-goto-frame) - (define-key map "f" 'image-next-frame) - (define-key map "b" 'image-previous-frame) - (define-key map "a+" 'image-increase-speed) - (define-key map "a-" 'image-decrease-speed) - (define-key map "a0" 'image-reset-speed) - (define-key map "ar" 'image-reverse-speed) - - ;; File keys - (define-key map "n" 'image-next-file) - (define-key map "p" 'image-previous-file) - (define-key map "w" 'image-mode-copy-file-name-as-kill) - (define-key map "m" 'image-mode-mark-file) - (define-key map "u" 'image-mode-unmark-file) - - ;; Scrolling keys - (define-key map (kbd "SPC") 'image-scroll-up) - (define-key map (kbd "S-SPC") 'image-scroll-down) - (define-key map (kbd "DEL") 'image-scroll-down) - (define-key map [remap forward-char] 'image-forward-hscroll) - (define-key map [remap backward-char] 'image-backward-hscroll) - (define-key map [remap right-char] 'image-forward-hscroll) - (define-key map [remap left-char] 'image-backward-hscroll) - (define-key map [remap previous-line] 'image-previous-line) - (define-key map [remap next-line] 'image-next-line) - (define-key map [remap scroll-up] 'image-scroll-up) - (define-key map [remap scroll-down] 'image-scroll-down) - (define-key map [remap scroll-up-command] 'image-scroll-up) - (define-key map [remap scroll-down-command] 'image-scroll-down) - (define-key map [remap scroll-left] 'image-scroll-left) - (define-key map [remap scroll-right] 'image-scroll-right) - (define-key map [remap move-beginning-of-line] 'image-bol) - (define-key map [remap move-end-of-line] 'image-eol) - (define-key map [remap beginning-of-buffer] 'image-bob) - (define-key map [remap end-of-buffer] 'image-eob) - - (easy-menu-define image-mode-menu map "Menu for Image mode." - '("Image" - ["Show as Text" image-toggle-display :active t - :help "Show image as text"] +(defvar-keymap image-mode-map + :doc "Mode keymap for `image-mode'." + :parent (make-composed-keymap image-map special-mode-map) + + ;; Toggling keys + "C-c C-c" #'image-toggle-display + "C-c C-x" #'image-toggle-hex-display + + ;; Transformation keys + "s f" #'image-mode-fit-frame + "s w" #'image-transform-fit-to-window + "s h" #'image-transform-fit-to-height + "s i" #'image-transform-fit-to-width + "s b" #'image-transform-fit-both + "s p" #'image-transform-set-percent + "s s" #'image-transform-set-scale + "s r" #'image-transform-set-rotation + "s m" #'image-transform-set-smoothing + "s o" #'image-transform-original + "s 0" #'image-transform-reset + + ;; Multi-frame keys + "RET" #'image-toggle-animation + "F" #'image-goto-frame + "f" #'image-next-frame + "b" #'image-previous-frame + "a +" #'image-increase-speed + "a -" #'image-decrease-speed + "a 0" #'image-reset-speed + "a r" #'image-reverse-speed + + ;; File keys + "n" #'image-next-file + "p" #'image-previous-file + "w" #'image-mode-copy-file-name-as-kill + "m" #'image-mode-mark-file + "u" #'image-mode-unmark-file + + ;; Scrolling keys + "SPC" #'image-scroll-up + "S-SPC" #'image-scroll-down + "DEL" #'image-scroll-down + + ;; Remapped + "<remap> <forward-char>" #'image-forward-hscroll + "<remap> <backward-char>" #'image-backward-hscroll + "<remap> <right-char>" #'image-forward-hscroll + "<remap> <left-char>" #'image-backward-hscroll + "<remap> <previous-line>" #'image-previous-line + "<remap> <next-line>" #'image-next-line + "<remap> <scroll-up>" #'image-scroll-up + "<remap> <scroll-down>" #'image-scroll-down + "<remap> <scroll-up-command>" #'image-scroll-up + "<remap> <scroll-down-command>" #'image-scroll-down + "<remap> <scroll-left>" #'image-scroll-left + "<remap> <scroll-right>" #'image-scroll-right + "<remap> <move-beginning-of-line>" #'image-bol + "<remap> <move-end-of-line>" #'image-eol + "<remap> <beginning-of-buffer>" #'image-bob + "<remap> <end-of-buffer>" #'image-eob) + +(easy-menu-define image-mode-menu image-mode-map + "Menu for Image mode." + '("Image" + ["Show as Text" image-toggle-display :active t + :help "Show image as text"] ["Show as Hex" image-toggle-hex-display :active t :help "Show image as hex"] - "--" - ["Fit Frame to Image" image-mode-fit-frame :active t - :help "Resize frame to match image"] - ["Fit Image to Window" image-transform-fit-to-window - :help "Resize image to match the window height and width"] - ["Fit Image to Window (Scale down only)" image-transform-fit-both - :help "Scale image down to match the window height and width"] - ["Zoom In" image-increase-size - :help "Enlarge the image"] - ["Zoom Out" image-decrease-size - :help "Shrink the image"] - ["Set Scale..." image-transform-set-scale - :help "Resize image by specified scale factor"] - ["Rotate Clockwise" image-rotate - :help "Rotate the image"] - ["Set Rotation..." image-transform-set-rotation - :help "Set rotation angle of the image"] - ["Set Smoothing..." image-transform-set-smoothing - :help "Toggle smoothing"] - ["Original Size" image-transform-original - :help "Reset image to actual size"] - ["Reset to Default Size" image-transform-reset - :help "Reset all image transformations to initial size"] - "--" - ["Show Thumbnails" - (lambda () - (interactive) - (image-dired default-directory)) - :active default-directory - :help "Show thumbnails for all images in this directory"] - ["Previous Image" image-previous-file :active buffer-file-name - :help "Move to previous image in this directory"] - ["Next Image" image-next-file :active buffer-file-name - :help "Move to next image in this directory"] - ["Copy File Name" image-mode-copy-file-name-as-kill - :active buffer-file-name - :help "Copy the current file name to the kill ring"] - "--" - ["Animate Image" image-toggle-animation :style toggle - :selected (let ((image (image-get-display-property))) - (and image (image-animate-timer image))) - :active image-multi-frame - :help "Toggle image animation"] - ["Loop Animation" - (lambda () (interactive) - (setq image-animate-loop (not image-animate-loop)) - ;; FIXME this is a hacky way to make it affect a currently - ;; animating image. - (when (let ((image (image-get-display-property))) - (and image (image-animate-timer image))) - (image-toggle-animation) - (image-toggle-animation))) - :style toggle :selected image-animate-loop - :active image-multi-frame - :help "Animate images once, or forever?"] - ["Reverse Animation" image-reverse-speed - :style toggle :selected (let ((image (image-get-display-property))) - (and image (< - (image-animate-get-speed image) - 0))) - :active image-multi-frame - :help "Reverse direction of this image's animation?"] - ["Speed Up Animation" image-increase-speed - :active image-multi-frame - :help "Speed up this image's animation"] - ["Slow Down Animation" image-decrease-speed - :active image-multi-frame - :help "Slow down this image's animation"] - ["Reset Animation Speed" image-reset-speed - :active image-multi-frame - :help "Reset the speed of this image's animation"] - ["Previous Frame" image-previous-frame :active image-multi-frame - :help "Show the previous frame of this image"] - ["Next Frame" image-next-frame :active image-multi-frame - :help "Show the next frame of this image"] - ["Goto Frame..." image-goto-frame :active image-multi-frame - :help "Show a specific frame of this image"] - )) - (make-composed-keymap (list map image-map) special-mode-map)) - "Mode keymap for `image-mode'.") - -(defvar image-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'image-toggle-display) - (define-key map "\C-c\C-x" 'image-toggle-hex-display) - map) - "Mode keymap for `image-minor-mode'.") + "--" + ["Fit Frame to Image" image-mode-fit-frame :active t + :help "Resize frame to match image"] + ["Fit Image to Window" image-transform-fit-to-window + :help "Resize image to match the window height and width"] + ["Fit Image to Window (Scale down only)" image-transform-fit-both + :help "Scale image down to match the window height and width"] + ["Zoom In" image-increase-size + :help "Enlarge the image"] + ["Zoom Out" image-decrease-size + :help "Shrink the image"] + ["Set Scale..." image-transform-set-scale + :help "Resize image by specified scale factor"] + ["Rotate Clockwise" image-rotate + :help "Rotate the image"] + ["Set Rotation..." image-transform-set-rotation + :help "Set rotation angle of the image"] + ["Set Smoothing..." image-transform-set-smoothing + :help "Toggle smoothing"] + ["Original Size" image-transform-original + :help "Reset image to actual size"] + ["Reset to Default Size" image-transform-reset + :help "Reset all image transformations to initial size"] + "--" + ["Show Thumbnails" + (lambda () + (interactive) + (image-dired default-directory)) + :active default-directory + :help "Show thumbnails for all images in this directory"] + ["Previous Image" image-previous-file :active buffer-file-name + :help "Move to previous image in this directory"] + ["Next Image" image-next-file :active buffer-file-name + :help "Move to next image in this directory"] + ["Copy File Name" image-mode-copy-file-name-as-kill + :active buffer-file-name + :help "Copy the current file name to the kill ring"] + "--" + ["Animate Image" image-toggle-animation :style toggle + :selected (let ((image (image-get-display-property))) + (and image (image-animate-timer image))) + :active image-multi-frame + :help "Toggle image animation"] + ["Loop Animation" + (lambda () (interactive) + (setq image-animate-loop (not image-animate-loop)) + ;; FIXME this is a hacky way to make it affect a currently + ;; animating image. + (when (let ((image (image-get-display-property))) + (and image (image-animate-timer image))) + (image-toggle-animation) + (image-toggle-animation))) + :style toggle :selected image-animate-loop + :active image-multi-frame + :help "Animate images once, or forever?"] + ["Reverse Animation" image-reverse-speed + :style toggle :selected (let ((image (image-get-display-property))) + (and image (< + (image-animate-get-speed image) + 0))) + :active image-multi-frame + :help "Reverse direction of this image's animation?"] + ["Speed Up Animation" image-increase-speed + :active image-multi-frame + :help "Speed up this image's animation"] + ["Slow Down Animation" image-decrease-speed + :active image-multi-frame + :help "Slow down this image's animation"] + ["Reset Animation Speed" image-reset-speed + :active image-multi-frame + :help "Reset the speed of this image's animation"] + ["Previous Frame" image-previous-frame :active image-multi-frame + :help "Show the previous frame of this image"] + ["Next Frame" image-next-frame :active image-multi-frame + :help "Show the next frame of this image"] + ["Goto Frame..." image-goto-frame :active image-multi-frame + :help "Show a specific frame of this image"])) + +(defvar-keymap image-minor-mode-map + :doc "Mode keymap for `image-minor-mode'." + "C-c C-c" #'image-toggle-display + "C-c C-x" #'image-toggle-hex-display) (defvar bookmark-make-record-function) @@ -750,9 +754,9 @@ Key bindings: (define-minor-mode image-minor-mode "Toggle Image minor mode in this buffer. -Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], -to switch back to `image-mode' and display an image file as the -actual image." +Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], \ +to switch back to +`image-mode' and display an image file as the actual image." :lighter (:eval (if image-type (format " Image[%s]" image-type) " Image")) :group 'image :version "22.1" @@ -769,18 +773,17 @@ displays an image file as text." (major-mode-restore '(image-mode image-mode-as-text)) ;; Restore `image-type' after `kill-all-local-variables' in `normal-mode'. (setq image-type previous-image-type) - ;; Enable image minor mode with `C-c C-c'. - (image-minor-mode 1) (unless (image-get-display-property) ;; Show the image file as text. (image-toggle-display-text)))) (defun image-mode-as-hex () - "Set a non-image mode as major mode in combination with image minor mode. + "Set `hexl-mode' as major mode in combination with image minor mode. A non-mage major mode found from `auto-mode-alist' or fundamental mode displays an image file as hex. `image-minor-mode' provides the key -\\<image-mode-map>\\[image-toggle-hex-display] to switch back to `image-mode' -to display an image file as the actual image. +\\<image-mode-map>\\[image-toggle-hex-display] to switch back to `image-mode' \ +to display an image file as +the actual image. You can use `image-mode-as-hex' in `auto-mode-alist' when you want to display an image file as hex initially. @@ -789,13 +792,11 @@ See commands `image-mode' and `image-minor-mode' for more information on these modes." (interactive) (image-mode-to-text) - ;; Turn on hexl-mode (hexl-mode) + (image-minor-mode 1) (message (substitute-command-keys - "Type \\[image-toggle-hex-display] or \ -\\[image-toggle-display] to view the image as %s") - (if (image-get-display-property) - "hex" "an image or text"))) + "Type \\[image-toggle-display] or \ +\\[image-toggle-hex-display] to view the image as an image"))) (defun image-mode-as-text () "Set a non-image mode as major mode in combination with image minor mode. @@ -811,6 +812,7 @@ See commands `image-mode' and `image-minor-mode' for more information on these modes." (interactive) (image-mode-to-text) + (image-minor-mode 1) (message (substitute-command-keys "Type \\[image-toggle-display] to view the image as %s") (if (image-get-display-property) @@ -986,14 +988,17 @@ was inserted." (memq (intern (upcase (file-name-extension filename)) obarray) imagemagick-types-inhibit))))) +(declare-function hexl-mode-exit "hexl" (&optional arg)) + (defun image-toggle-hex-display () "Toggle between image and hex display." (interactive) - (if (image-get-display-property) - (image-mode-as-hex) - (if (eq major-mode 'fundamental-mode) - (image-mode-as-hex) - (image-mode)))) + (cond ((or (image-get-display-property) ; in `image-mode' + (eq major-mode 'fundamental-mode)) + (image-mode-as-hex)) + ((eq major-mode 'hexl-mode) + (hexl-mode-exit)) + (t (error "That command is invalid here")))) (defun image-toggle-display () "Toggle between image and text display. @@ -1002,15 +1007,15 @@ If the current buffer is displaying an image file as an image, call `image-mode-as-text' to switch to text or hex display. Otherwise, display the image by calling `image-mode'." (interactive) - (if (image-get-display-property) - (image-mode-as-text) - (if (eq major-mode 'hexl-mode) - (image-mode-as-text) - (image-mode)))) + (cond ((image-get-display-property) ; in `image-mode' + (image-mode-as-text)) + ((eq major-mode 'hexl-mode) + (hexl-mode-exit)) + ((image-mode)))) (defun image-kill-buffer () "Kill the current buffer." - (interactive) + (interactive nil image-mode) (kill-buffer (current-buffer))) (defun image-after-revert-hook () @@ -1191,7 +1196,7 @@ current one, in cyclic alphabetical order. This command visits the specified file via `find-alternate-file', replacing the current Image mode buffer." - (interactive "p") + (interactive "p" image-mode) (unless (derived-mode-p 'image-mode) (error "The buffer is not in Image mode")) (unless buffer-file-name @@ -1223,7 +1228,7 @@ tar mode buffers." (when (buffer-live-p archive-superior-buffer) (push (cons 'archive archive-superior-buffer) buffers))) (t - ;; Find a dired buffer. + ;; Find a Dired buffer. (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (and (derived-mode-p 'dired-mode) @@ -1232,7 +1237,7 @@ tar mode buffers." (equal (file-truename dir) (file-truename default-directory))) (push (cons 'dired (current-buffer)) buffers)))) - ;; If we can't find any buffers to navigate in, we open a dired + ;; If we can't find any buffers to navigate in, we open a Dired ;; buffer. (unless buffers (push (cons 'dired (find-file-noselect dir)) buffers) @@ -1244,14 +1249,14 @@ tar mode buffers." (defun image-mode--next-file (file n) "Go to the next image file in the parent buffer of FILE. -This is typically a dired buffer, but may also be a tar/archive buffer. +This is typically a Dired buffer, but may also be a tar/archive buffer. Return the next image file from that buffer. If N is negative, go to the previous file." (let ((regexp (image-file-name-regexp)) (buffers (image-mode--directory-buffers file)) next) (dolist (buffer buffers) - ;; We do this traversal for all the dired buffers open on this + ;; We do this traversal for all the Dired buffers open on this ;; directory. There probably is just one, but we want to move ;; point in all of them. (save-window-excursion @@ -1288,36 +1293,36 @@ current one, in cyclic alphabetical order. This command visits the specified file via `find-alternate-file', replacing the current Image mode buffer." - (interactive "p") + (interactive "p" image-mode) (image-next-file (- n))) (defun image-mode-copy-file-name-as-kill () "Push the currently visited file name onto the kill ring." - (interactive) + (interactive nil image-mode) (unless buffer-file-name (error "The current buffer doesn't visit a file")) (kill-new buffer-file-name) (message "Copied %s" buffer-file-name)) (defun image-mode-mark-file () - "Mark the current file in the appropriate dired buffer(s). -Any dired buffer that's opened to the current file's directory + "Mark the current file in the appropriate Dired buffer(s). +Any Dired buffer that's opened to the current file's directory will have the line where the image appears (if any) marked. If no such buffer exists, it will be opened." - (interactive) + (interactive nil image-mode) (unless buffer-file-name (error "Current buffer is not visiting a file")) (image-mode--mark-file buffer-file-name #'dired-mark "marked")) (defun image-mode-unmark-file () - "Unmark the current file in the appropriate dired buffer(s). -Any dired buffer that's opened to the current file's directory + "Unmark the current file in the appropriate Dired buffer(s). +Any Dired buffer that's opened to the current file's directory will remove the mark from the line where the image appears (if any). If no such buffer exists, it will be opened." - (interactive) + (interactive nil image-mode) (unless buffer-file-name (error "Current buffer is not visiting a file")) (image-mode--mark-file buffer-file-name #'dired-unmark "unmarked")) @@ -1384,26 +1389,6 @@ If no such buffer exists, it will be opened." (image-toggle-display)))) -;; Not yet implemented. -;; (defvar image-transform-minor-mode-map -;; (let ((map (make-sparse-keymap))) -;; ;; (define-key map [(control ?+)] 'image-scale-in) -;; ;; (define-key map [(control ?-)] 'image-scale-out) -;; ;; (define-key map [(control ?=)] 'image-scale-none) -;; ;; (define-key map "c f h" 'image-scale-fit-height) -;; ;; (define-key map "c ]" 'image-rotate-right) -;; map) -;; "Minor mode keymap `image-transform-mode'.") -;; -;; (define-minor-mode image-transform-mode -;; "Minor mode for scaling and rotating images. -;; With a prefix argument ARG, enable the mode if ARG is positive, -;; and disable it otherwise. If called from Lisp, enable the mode -;; if ARG is omitted or nil. This minor mode requires Emacs to have -;; been compiled with ImageMagick support." -;; nil "image-transform" image-transform-minor-mode-map) - - (defsubst image-transform-width (width height) "Return the bounding box width of a rotated WIDTH x HEIGHT rectangle. The rotation angle is the value of `image-transform-rotation' in degrees." @@ -1551,61 +1536,73 @@ return value is suitable for appending to an image spec." (list :transform-smoothing (string= image--transform-smoothing "smooth"))))))) +(defun image-transform-set-percent (scale) + "Prompt for a percentage, and resize the current image to that size. +The percentage is in relation to the original size of the image." + (interactive (list (read-number "Scale (% of original): " 100 + 'read-number-history)) + image-mode) + (unless (cl-plusp scale) + (error "Not a positive number: %s" scale)) + (setq image-transform-resize (/ scale 100.0)) + (image-toggle-display-image)) + (defun image-transform-set-scale (scale) "Prompt for a number, and resize the current image by that amount." - (interactive "nScale: ") + (interactive "nScale: " image-mode) (setq image-transform-resize scale) (image-toggle-display-image)) (defun image-transform-fit-to-height () "Fit the current image to the height of the current window." - (declare (obsolete nil "29.1")) - (interactive) + (declare (obsolete image-transform-fit-to-window "29.1")) + (interactive nil image-mode) (setq image-transform-resize 'fit-height) (image-toggle-display-image)) (defun image-transform-fit-to-width () "Fit the current image to the width of the current window." - (declare (obsolete nil "29.1")) - (interactive) + (declare (obsolete image-transform-fit-to-window "29.1")) + (interactive nil image-mode) (setq image-transform-resize 'fit-width) (image-toggle-display-image)) (defun image-transform-fit-both () "Scale the current image down to fit in the current window." - (interactive) + (interactive nil image-mode) (setq image-transform-resize t) (image-toggle-display-image)) (defun image-transform-fit-to-window () "Fit the current image to the height and width of the current window." - (interactive) + (interactive nil image-mode) (setq image-transform-resize 'fit-window) (image-toggle-display-image)) (defun image-transform-set-rotation (rotation) "Prompt for an angle ROTATION, and rotate the image by that amount. ROTATION should be in degrees." - (interactive "nRotation angle (in degrees): ") + (interactive "nRotation angle (in degrees): " image-mode) (setq image-transform-rotation (float (mod rotation 360))) (image-toggle-display-image)) (defun image-transform-set-smoothing (smoothing) (interactive (list (completing-read "Smoothing: " - '("none" "smooth") nil t))) + '("none" "smooth") nil t)) + image-mode) (setq image--transform-smoothing smoothing) (image-toggle-display-image)) (defun image-transform-original () "Display the current image with the original (actual) size and rotation." - (interactive) + (interactive nil image-mode) (setq image-transform-resize nil image-transform-scale 1) (image-toggle-display-image)) (defun image-transform-reset () "Display the current image with the default (initial) size and rotation." - (interactive) + (interactive nil image-mode) (setq image-transform-resize image-auto-resize image-transform-rotation 0.0 image-transform-scale 1 diff --git a/lisp/image.el b/lisp/image.el index de2afdc2c7b..9311125450a 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -32,6 +32,8 @@ :group 'multimedia) (declare-function image-flush "image.c" (spec &optional frame)) +(declare-function clear-image-cache "image.c" + (&optional filter animation-cache)) (defconst image-type-header-regexps `(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm) diff --git a/lisp/indent.el b/lisp/indent.el index f52b729051d..b0c1a021da7 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -734,7 +734,9 @@ You can add or remove colons and then do \\<edit-tab-stops-map>\\[edit-tab-stops (while (> count 0) (insert "0123456789") (setq count (1- count)))) - (insert "\nTo install changes, type C-c C-c") + (insert (substitute-command-keys + (concat "\nTo install changes, type \\<edit-tab-stops-map>" + "\\[edit-tab-stops-note-changes]"))) (goto-char (point-min))) (defun edit-tab-stops-note-changes () diff --git a/lisp/info-look.el b/lisp/info-look.el index 7f45f976a24..ce0a08dcbe6 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -130,7 +130,8 @@ OTHER-MODES is a list of cross references to other help modes.") (defun info-lookup--expand-info (info) ;; We have a dynamic doc-spec function. (when (and (null (nth 3 info)) - (nth 6 info)) + (nth 6 info) + (functionp (nth 6 info))) (setf (nth 3 info) (funcall (nth 6 info)) (nth 6 info) nil)) info) diff --git a/lisp/info.el b/lisp/info.el index 7c1b34ed642..fb4c3fd7829 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -289,12 +289,10 @@ with wrapping around the current Info node." (defvar Info-isearch-initial-history nil) (defvar Info-isearch-initial-history-list nil) -(defcustom Info-mode-hook - ;; Try to obey obsolete Info-fontify settings. - (unless (and (boundp 'Info-fontify) (null Info-fontify)) - '(turn-on-font-lock)) +(defcustom Info-mode-hook '(turn-on-font-lock) "Hook run when activating Info Mode." - :type 'hook) + :type 'hook + :version "29.1") (defcustom Info-selection-hook nil "Hook run when an Info node is selected as the current node." diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el index af751927932..4de1d6084fb 100644 --- a/lisp/international/latin1-disp.el +++ b/lisp/international/latin1-disp.el @@ -756,6 +756,7 @@ use either \\[customize] or the function `latin1-display'." (latin1-display-ucs-per-lynx 1) (latin1-display-ucs-per-lynx -1)))) +;;;###autoload (defun latin1-display-ucs-per-lynx (arg) "Set up Latin-1/ASCII display for Unicode characters. This uses the transliterations of the Lynx browser. diff --git a/lisp/isearch.el b/lisp/isearch.el index 31fcf01949f..9f1fbb14a4a 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -4512,21 +4512,35 @@ is a list of cons cells of the form (START . END)." (setq bounds (cdr bounds)))) found)))) -(defun isearch-search-fun-in-text-property (search-fun property) - "Return the function to search inside text that has the specified PROPERTY. +(defun isearch-search-fun-in-text-property (search-fun properties) + "Return the function to search inside text that has the specified PROPERTIES. The function will limit the search for matches only inside text which has -this property in the current buffer. +at least one of the text PROPERTIES. The argument SEARCH-FUN provides the function to search text, and defaults to the value of `isearch-search-fun-default' when nil." + (setq properties (ensure-list properties)) (apply-partially #'search-within-boundaries search-fun - (lambda (pos) (get-text-property (if isearch-forward pos - (max (1- pos) (point-min))) - property)) - (lambda (pos) (if isearch-forward - (next-single-property-change pos property) - (previous-single-property-change pos property))))) + (lambda (pos) + (let ((pos (if isearch-forward pos (max (1- pos) (point-min))))) + (seq-some (lambda (property) + (get-text-property pos property)) + properties))) + (lambda (pos) + (let ((pos-list (if isearch-forward + (mapcar (lambda (property) + (next-single-property-change + pos property)) + properties) + (mapcar (lambda (property) + (previous-single-property-change + pos property)) + properties)))) + (setq pos-list (delq nil pos-list)) + (when pos-list (if isearch-forward + (seq-min pos-list) + (seq-max pos-list))))))) (defun search-within-boundaries ( search-fun get-fun next-fun string &optional bound noerror count) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 855f5a25b16..07dfc23a092 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -2714,6 +2714,11 @@ Normally you should let-bind `byte-compile-warnings' before calling this, else the global value will be modified. (fn WARNING)") +(autoload 'byte-compile-warn-obsolete "bytecomp" "\ +Warn that SYMBOL (a variable, function or generalized variable) is obsolete. +TYPE is a string that say which one of these three types it is. + +(fn SYMBOL TYPE)") (autoload 'byte-force-recompile "bytecomp" "\ Recompile every `.el' file in DIRECTORY that already has a `.elc' file. Files in subdirectories of DIRECTORY are processed also. @@ -5150,13 +5155,9 @@ PersistMoniker=file://Folder.htt (fn)" t) (autoload 'conf-javaprop-mode "conf-mode" "\ Conf Mode starter for Java properties files. -Comments start with `#' but are also recognized with `//' or -between `/*' and `*/'. -For details see `conf-mode'. Example: +Comments start with `#'. Example: # Conf mode font-locks this right with \\[conf-javaprop-mode] (Java properties) -// another kind of comment -/* yet another */ name:value name=value @@ -14553,7 +14554,7 @@ simple PLACEs such as (symbol-function \\='foo) which will also work in dynamic binding mode. (fn PLACE)" nil t) -(register-definition-prefixes "gv" '("gv-")) +(register-definition-prefixes "gv" '("gv-" "make-obsolete-generalized-variable")) ;;; Generated autoloads from play/handwrite.el @@ -17086,9 +17087,8 @@ Key bindings: (autoload 'image-minor-mode "image-mode" "\ Toggle Image minor mode in this buffer. -Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], -to switch back to `image-mode' and display an image file as the -actual image. +Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], to switch back to +`image-mode' and display an image file as the actual image. This is a minor mode. If called interactively, toggle the `Image minor mode' mode. If the prefix argument is positive, enable the diff --git a/lisp/linum.el b/lisp/linum.el index d491da52066..1b897a2bd22 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -89,9 +89,6 @@ Linum mode is a buffer-local minor mode." 'linum-update-current) nil t) (add-hook 'after-change-functions 'linum-after-change nil t)) (add-hook 'window-scroll-functions 'linum-after-scroll nil t) - ;; Using both window-size-change-functions and - ;; window-configuration-change-hook seems redundant. --Stef - ;; (add-hook 'window-size-change-functions 'linum-after-size nil t) (add-hook 'change-major-mode-hook 'linum-delete-overlays nil t) (add-hook 'window-configuration-change-hook ;; FIXME: If the buffer is shown in N windows, this @@ -101,7 +98,6 @@ Linum mode is a buffer-local minor mode." (linum-update-current)) (remove-hook 'post-command-hook 'linum-update-current t) (remove-hook 'post-command-hook 'linum-schedule t) - ;; (remove-hook 'window-size-change-functions 'linum-after-size t) (remove-hook 'window-scroll-functions 'linum-after-scroll t) (remove-hook 'after-change-functions 'linum-after-change t) (remove-hook 'window-configuration-change-hook 'linum-update-current t) @@ -231,16 +227,10 @@ Linum mode is a buffer-local minor mode." (defun linum-after-scroll (win _start) (linum-update (window-buffer win))) -;; (defun linum-after-size (frame) -;; (linum-after-config)) - (defun linum-schedule () ;; schedule an update; the delay gives Emacs a chance for display changes (run-with-idle-timer 0 nil #'linum-update-current)) -;; (defun linum-after-config () -;; (walk-windows (lambda (w) (linum-update (window-buffer w))) nil 'visible)) - (defun linum-unload-function () "Unload the Linum library." (global-linum-mode -1) diff --git a/lisp/loadup.el b/lisp/loadup.el index 17e82cc0c49..634a3314361 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -478,17 +478,12 @@ lost after dumping"))) ;; installed or if the source directory got moved. This is set to be ;; a pair in the form of: ;; (rel-filename-from-install-bin . rel-filename-from-local-bin). - (let ((h (make-hash-table :test #'eq)) - (bin-dest-dir (cadr (member "--bin-dest" command-line-args))) + (let ((bin-dest-dir (cadr (member "--bin-dest" command-line-args))) (eln-dest-dir (cadr (member "--eln-dest" command-line-args)))) (when (and bin-dest-dir eln-dest-dir) (setq eln-dest-dir (concat eln-dest-dir "native-lisp/" comp-native-version-dir "/")) - (mapatoms (lambda (s) - (let ((f (symbol-function s))) - (when (subr-native-elisp-p f) - (puthash (subr-native-comp-unit f) nil h))))) - (maphash (lambda (cu _) + (maphash (lambda (_ cu) (let* ((file (native-comp-unit-file cu)) (preloaded (equal (substring (file-name-directory file) -10 -1) @@ -508,7 +503,7 @@ lost after dumping"))) bin-dest-dir) ;; Relative filename from the built uninstalled binary. (file-relative-name file invocation-directory))))) - h)))) + comp-loaded-comp-units-h)))) (when (hash-table-p purify-flag) (let ((strings 0) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 6cc99c21348..d72809b186d 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -387,10 +387,12 @@ copy text to your preferred mail program.\n" (goto-char user-point))) (defun emacs-bug--system-description () - (insert "\nIn " (emacs-version)) - (if emacs-build-system - (insert " built on " emacs-build-system)) - (insert "\n") + (let ((start (point))) + (insert "\nIn " (emacs-version)) + (if emacs-build-system + (insert " built on " emacs-build-system)) + (insert "\n") + (fill-region-as-paragraph start (point))) (if (stringp emacs-repository-version) (insert "Repository revision: " emacs-repository-version "\n")) diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index 63752f953a7..a6e508155f6 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -310,7 +310,7 @@ matches may be returned from the message body." (buffer-substring-no-properties opoint (point))))) (if delete - (delete-region (point-at-bol) (point))))) + (delete-region (line-beginning-position) (point))))) (if list value (and (not (string= value "")) value))) @@ -326,7 +326,8 @@ matches may be returned from the message body." (prog1 (buffer-substring-no-properties opoint (point)) (if delete - (delete-region (point-at-bol) (1+ (point)))))))))))) + (delete-region (line-beginning-position) + (1+ (point)))))))))))) ;; Parse a list of tokens separated by commas. ;; It runs from point to the end of the visible part of the buffer. diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 86711a4543f..0e0fb512003 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -394,7 +394,7 @@ with a space." (let (p) (save-excursion (while (>= (current-column) fill-column) - (while (and (search-backward "," (point-at-bol) 'move) + (while (and (search-backward "," (line-beginning-position) 'move) (>= (current-column) (1- fill-column)) (setq p (point)))) (when (or (not (bolp)) diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el index 2ab4fa411a6..0673493487a 100644 --- a/lisp/mail/mspools.el +++ b/lisp/mail/mspools.el @@ -264,7 +264,7 @@ Buffer is not displayed if SHOW is non-nil." (delete-char 1)))) (message "folder %s spool %s" folder-name spool-name) - (forward-line (if (eq (count-lines (point-min) (point-at-eol)) + (forward-line (if (eq (count-lines (point-min) (line-end-position)) mspools-files-len) ;; FIXME: Why use `mspools-files-len' instead ;; of looking if we're on the last line and @@ -307,7 +307,7 @@ Buffer is not displayed if SHOW is non-nil." (defun mspools-get-spool-name () "Return the name of the spool on the current line." - (let ((line-num (1- (count-lines (point-min) (point-at-eol))))) + (let ((line-num (1- (count-lines (point-min) (line-end-position))))) ;; FIXME: Why not extract the name directly from the current line's text? (car (nth line-num mspools-files)))) diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index 67874d508b1..abb95a63f16 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -175,7 +175,7 @@ This is either `base64' or `quoted-printable'." (progn (forward-line 1) (if (re-search-forward "^[^ \n\t]" nil t) - (point-at-bol) + (line-beginning-position) (point-max)))) (goto-char (point-min))) @@ -681,14 +681,14 @@ Point moves to the end of the region." (goto-char b) (setq b (point-marker) e (set-marker (make-marker) e)) - (rfc2047-fold-region (point-at-bol) b) + (rfc2047-fold-region (line-beginning-position) b) (goto-char b) (skip-chars-backward "^ \t\n") (unless (= 0 (skip-chars-backward " \t")) ;; `crest' may contain whitespace and an open parenthesis. (setq crest (buffer-substring-no-properties (point) b))) (setq eword (rfc2047-encode-1 - (- b (point-at-bol)) + (- b (line-beginning-position)) (replace-regexp-in-string "\n\\([ \t]?\\)" "\\1" (buffer-substring-no-properties b e)) @@ -824,18 +824,18 @@ Return the new end point." (goto-char (point-min)) (let ((bol (save-restriction (widen) - (point-at-bol))) - (eol (point-at-eol))) + (line-beginning-position))) + (eol (line-end-position))) (forward-line 1) (while (not (eobp)) (if (and (looking-at "[ \t]") - (< (- (point-at-eol) bol) 76)) + (< (- (line-end-position) bol) 76)) (delete-region eol (progn (goto-char eol) (skip-chars-forward "\r\n") (point))) - (setq bol (point-at-bol))) - (setq eol (point-at-eol)) + (setq bol (line-beginning-position))) + (setq eol (line-end-position)) (forward-line 1))))) (defun rfc2047-b-encode-string (string) diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 79f421bdcd6..416f7d1ea89 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -796,8 +796,9 @@ directly." ((string-match "text/" content-type) (setq type 'text)) ((string-match "image/\\(.*\\)" content-type) - (setq type (image-supported-file-p - (concat "." (match-string 1 content-type)))) + (setq type (and (fboundp 'image-supported-file-p) + (image-supported-file-p + (concat "." (match-string 1 content-type))))) (when (and type rmail-mime-show-images (not (eq rmail-mime-show-images 'button)) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 189ad075c47..387792eb310 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1293,7 +1293,7 @@ external program defined by `sendmail-program'." ;; should override any specified in the message itself. (when where-content-type (goto-char where-content-type) - (delete-region (point-at-bol) + (delete-region (line-beginning-position) (progn (forward-line 1) (point))))))) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 45b25b55301..8573532eac2 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -474,7 +474,7 @@ for `smtpmail-try-auth-method'.") (smtpmail--sanitize-error-message result)))))) (delete-file file-data) (delete-file file-elisp) - (delete-region (point-at-bol) (point-at-bol 2))) + (delete-region (line-beginning-position) (line-beginning-position 2))) (write-region (point-min) (point-max) qfile)))) (defun smtpmail--sanitize-error-message (string) @@ -577,7 +577,7 @@ for `smtpmail-try-auth-method'.") (stringp result)) (setq result (catch 'done (smtpmail-try-auth-method - process (pop mechs) user password)))) + process (intern-soft (pop mechs)) user password)))) ;; A string result is an error. (if (stringp result) (progn @@ -1057,7 +1057,8 @@ Returns an error if the server cannot be contacted." (while data-continue (with-current-buffer buffer (progress-reporter-update pr (point)) - (setq sending-data (buffer-substring (point-at-bol) (point-at-eol))) + (setq sending-data (buffer-substring (line-beginning-position) + (line-end-position))) (end-of-line 2) (setq data-continue (not (eobp)))) (smtpmail-send-data-1 process sending-data)) diff --git a/lisp/man.el b/lisp/man.el index d66f63972ae..7ba7bee4176 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -168,13 +168,14 @@ pushy -- make the manpage the current buffer in the current window bully -- make the manpage the current buffer and only window (sf) aggressive -- make the manpage the current buffer in the other window (sf) friendly -- display manpage in the other window but don't make current (sf) +thrifty -- reuse an existing manpage window if possible (sf) polite -- don't display manpage, but prints message and beep when ready quiet -- like `polite', but don't beep meek -- make no indication that the manpage is ready Any other value of `Man-notify-method' is equivalent to `meek'." :type '(radio (const newframe) (const pushy) (const bully) - (const aggressive) (const friendly) + (const aggressive) (const friendly) (const thrifty) (const polite) (const quiet) (const meek)) :group 'man) @@ -1229,6 +1230,11 @@ See the variable `Man-notify-method' for the different notification behaviors." (and (frame-live-p saved-frame) (select-frame saved-frame)) (display-buffer man-buffer 'not-this-window)) + ('thrifty + (and (frame-live-p saved-frame) + (select-frame saved-frame)) + (display-buffer man-buffer '(display-buffer-reuse-mode-window + (mode . Man-mode)))) ('polite (beep) (message "Manual buffer %s is ready" (buffer-name man-buffer))) diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index 5b902902378..308660431ac 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -583,7 +583,7 @@ perform the operation on all messages in that region. (make-local-variable 'desktop-save-buffer) (setq desktop-save-buffer t) (setq-local - mh-colors-available-flag (mh-colors-available-p) + mh-colors-available-flag (display-color-p) ; Do we have colors available mh-current-folder (buffer-name) ; Name of folder, a string mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index 8339273fc9b..c82a1a53baf 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -802,7 +802,7 @@ that note messages to be refiled." "Return a list of message numbers from point to the end of the line. Expands ranges into set of individual numbers." (let ((msgs ()) - (end-of-line (point-at-eol)) + (end-of-line (line-end-position)) num) (while (re-search-forward "[0-9]+" end-of-line t) (setq num (string-to-number (buffer-substring (match-beginning 0) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index dd662f35522..b2c79350c46 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -60,13 +60,6 @@ used in lieu of `search' in the CL package." (set-syntax-table syntax-table)))) ;;;###mh-autoload -(defun mh-colors-available-p () - "Check if colors are available in the Emacs being used." - ;; FIXME: Can this be replaced with `display-color-p'? - (let ((color-cells (display-color-cells))) - (and (numberp color-cells) (>= color-cells 8)))) - -;;;###mh-autoload (defun mh-colors-in-use-p () "Check if colors are being used in the folder buffer." (and mh-colors-available-flag font-lock-mode)) @@ -1005,6 +998,9 @@ If the current line is too long truncate a part of it as well." (goto-char (point-min)) (re-search-forward mh-signature-separator-regexp nil t))) +;;;###mh-autoload +(define-obsolete-function-alias 'mh-colors-available-p #'display-color-p "29.1") + (provide 'mh-utils) ;; Local Variables: diff --git a/lisp/mouse.el b/lisp/mouse.el index bee664dc568..e38a4f8a71a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -869,6 +869,9 @@ must be one of the symbols `header', `mode', or `vertical'." map) t (lambda () (setq track-mouse old-track-mouse))))))) +;; In no-X builds, dnd.el isn't preloaded. +(autoload 'dnd-begin-file-drag "dnd") + (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on its mode line. START-EVENT is the starting mouse event of the drag action. diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index 3f7d9c00608..2f841336e0b 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -210,7 +210,7 @@ LOCATION is used as the phone location for BBDB." (while (eudc-move-to-next-record) (and (overlays-at (point)) (setq record (overlay-get (car (overlays-at (point))) 'eudc-record)) - (1+ nbrec) + (setq nbrec (1+ nbrec)) (eudc-create-bbdb-record record t))) (message "%d records imported into BBDB" nbrec))) diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index eb440ba6144..40cb25fca20 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -856,7 +856,7 @@ non-nil, collect results from all servers." (let* ((end (point)) (beg (save-excursion (if (re-search-backward "\\([:,]\\|^\\)[ \t]*" - (point-at-bol) 'move) + (line-beginning-position) 'move) (goto-char (match-end 0))) (point))) (query-words (split-string (buffer-substring-no-properties beg end) diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index 1201c84f2d3..86fe99f9e76 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -38,14 +38,6 @@ ;;{{{ Internal cooking -(defalias 'eudc-ldap-get-host-parameter - (if (fboundp 'ldap-get-host-parameter) - #'ldap-get-host-parameter - (lambda (host parameter) - "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'." - (plist-get (cdr (assoc host ldap-host-parameters-alist)) - parameter)))) - (defvar eudc-ldap-attributes-translation-alist '((name . sn) (firstname . givenname) @@ -209,7 +201,7 @@ attribute names are returned. Default to `person'." (defun eudc-ldap-check-base () "Check if the current LDAP server has a configured search base." - (unless (or (eudc-ldap-get-host-parameter eudc-server 'base) + (unless (or (ldap-get-host-parameter eudc-server 'base) ldap-default-base (null (y-or-n-p "No search base defined. Configure it now?"))) ;; If the server is not in ldap-host-parameters-alist we add it for the @@ -224,6 +216,8 @@ attribute names are returned. Default to `person'." (eudc-register-protocol 'ldap) +(define-obsolete-function-alias 'eudc-ldap-get-host-parameter #'ldap-get-host-parameter "29.1") + (provide 'eudcb-ldap) ;;; eudcb-ldap.el ends here diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 0b6488292de..fe78fbe8339 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -2556,7 +2556,7 @@ Return nil if no complete line has arrived." ;; next line for Courier IMAP bug. (skip-chars-forward " ") (point))) - (> (skip-chars-forward "^ )" (point-at-eol)) 0)) + (> (skip-chars-forward "^ )" (line-end-position)) 0)) (push (buffer-substring start (point)) flag-list)) (cl-assert (eq (char-after) ?\)) nil "In imap-parse-flag-list 2") (imap-forward) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 0f2943cbb03..5e14589d19b 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -694,7 +694,7 @@ an alist of attribute/value pairs." (while (progn (skip-chars-forward " \t\n") (not (eobp))) - (setq dn (buffer-substring (point) (point-at-eol))) + (setq dn (buffer-substring (point) (line-end-position))) (forward-line 1) (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\ \\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\ diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index e98767ae7c7..a1ac55bc7af 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -541,7 +541,7 @@ The sort function is chosen according to the value of (let ((inhibit-read-only t)) (goto-char (point-min)) (while (not (eobp)) - (let* ((pos (point-at-eol)) + (let* ((pos (line-end-position)) (item (get-text-property (point) :nt-item)) (age (newsticker--age item)) (selected (get-text-property (point) :nt-selected)) @@ -579,7 +579,8 @@ The sort function is chosen according to the value of (newsticker--treeview-list-clear-highlight) (with-current-buffer (newsticker--treeview-list-buffer) (let ((inhibit-read-only t)) - (put-text-property (point-at-bol) (point-at-eol) :nt-selected t)) + (put-text-property (line-beginning-position) (line-end-position) + :nt-selected t)) (newsticker--treeview-list-update-faces))) (defun newsticker--treeview-list-highlight-start () @@ -1080,7 +1081,7 @@ Arguments are ignored." (with-current-buffer (newsticker--treeview-tree-buffer) (goto-char pos) (move-overlay newsticker--tree-selection-overlay - (point-at-bol) (1+ (point-at-eol)) + (line-beginning-position) (1+ (line-end-position)) (current-buffer))) (if (window-live-p (newsticker--treeview-tree-window)) (set-window-point (newsticker--treeview-tree-window) pos))))) diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el index de225d76dcc..9d59ddf978d 100644 --- a/lisp/net/pop3.el +++ b/lisp/net/pop3.el @@ -469,7 +469,7 @@ Return non-nil if it is necessary to update the local UIDL file." (delete-char -3) (if (eq (char-before) ?\)) (insert ")\n ") - (goto-char (1+ (point-at-bol))) + (goto-char (1+ (line-beginning-position))) (delete-region (point) (point-max))))) (when (eq (char-before) ? ) (delete-char -2)) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 065398b64af..71505dcaa39 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1640,7 +1640,7 @@ Create the buffer if it doesn't exist." (goto-char (point-max)) (when (not (equal 0 (- (point) rcirc-prompt-end-marker))) ;; delete a trailing newline - (when (eq (point) (point-at-bol)) + (when (eq (point) (line-beginning-position)) (delete-char -1)) (let ((input (buffer-substring-no-properties rcirc-prompt-end-marker (point)))) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 170583f608c..b38b908edb0 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,7 +55,7 @@ It is used for TCP/IP devices." (defconst tramp-adb-method "adb" "When this method name is used, forward all calls to Android Debug Bridge.") -(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]" +(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") space) "Regexp used as prompt in almquist shell." :type 'regexp :version "28.1" @@ -63,31 +63,28 @@ It is used for TCP/IP devices." (eval-and-compile (defconst tramp-adb-ls-date-year-regexp - "[[:digit:]]\\{4\\}-[[:digit:]]\\{2\\}-[[:digit:]]\\{2\\}" + (rx (= 4 digit) "-" (= 2 digit) "-" (= 2 digit)) "Regexp for date year format in ls output.")) (eval-and-compile - (defconst tramp-adb-ls-date-time-regexp - "[[:digit:]]\\{2\\}:[[:digit:]]\\{2\\}" + (defconst tramp-adb-ls-date-time-regexp (rx (= 2 digit) ":" (= 2 digit)) "Regexp for date time format in ls output.")) (defconst tramp-adb-ls-date-regexp - (concat - "[[:space:]]" tramp-adb-ls-date-year-regexp - "[[:space:]]" tramp-adb-ls-date-time-regexp - "[[:space:]]") + (rx space (regexp tramp-adb-ls-date-year-regexp) + space (regexp tramp-adb-ls-date-time-regexp) + space) "Regexp for date format in ls output.") (defconst tramp-adb-ls-toolbox-regexp - (concat - "^[[:space:]]*\\([-.[:alpha:]]+\\)" ; \1 permissions - "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox) - "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username - "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group - "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size - "[[:space:]]+\\(" tramp-adb-ls-date-year-regexp - "[[:space:]]" tramp-adb-ls-date-time-regexp "\\)" ; \5 date - "[[:space:]]\\(.*\\)$") ; \6 filename + (rx bol (* space) (group (+ (any ".-" alpha))) ; \1 permissions + (? (+ space) (+ digit)) ; links (Android 7/toybox) + (* space) (group (+ (not space))) ; \2 username + (+ space) (group (+ (not space))) ; \3 group + (+ space) (group (+ digit)) ; \4 size + (+ space) (group (regexp tramp-adb-ls-date-year-regexp) + space (regexp tramp-adb-ls-date-time-regexp)) ; \5 date + space (group (* nonl)) eol) ; \6 filename "Regexp for ls output.") ;;;###tramp-autoload @@ -220,7 +217,8 @@ arguments to pass to the OPERATION." (delq nil (mapcar (lambda (line) - (when (string-match "^\\(\\S-+\\)[[:space:]]+device$" line) + (when (string-match + (rx bol (group (+ (not space))) (+ space) "device" eol) line) ;; Replace ":" by "#". `(nil ,(tramp-compat-string-replace ":" tramp-prefix-port-format (match-string 1 line))))) @@ -237,10 +235,10 @@ arguments to pass to the OPERATION." (goto-char (point-min)) (forward-line) (when (looking-at - (concat "[[:space:]]*[^[:space:]]+" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)")) + (rx (* space) (+ (not space)) + (+ space) (group (+ digit)) + (+ space) (group (+ digit)) + (+ space) (group (+ digit)))) ;; The values are given as 1k numbers, so we must change ;; them to number of bytes. (list (* 1024 (string-to-number (match-string 1))) @@ -280,10 +278,10 @@ arguments to pass to the OPERATION." (name (match-string 6)) (symlink-target (and is-symlink - (cadr (split-string name "\\( -> \\|\n\\)"))))) + (cadr (split-string name (rx (group (| " -> " "\n")))))))) (push (list (if is-symlink - (car (split-string name "\\( -> \\|\n\\)")) + (car (split-string name (rx (group (| " -> " "\n"))))) name) (or is-dir symlink-target) 1 ;link-count @@ -315,7 +313,7 @@ arguments to pass to the OPERATION." (tramp-shell-quote-argument localname))) ;; We insert also filename/. and filename/.., because "ls" ;; doesn't on some file systems, like "sdcard". - (unless (re-search-backward "\\.$" nil t) + (unless (re-search-backward (rx "." eol) nil t) (narrow-to-region (point-max) (point-max)) (tramp-adb-send-command v (format "%s -d -a -l %s %s | cat" @@ -325,9 +323,8 @@ arguments to pass to the OPERATION." (tramp-shell-quote-argument (tramp-compat-file-name-concat localname "..")))) (tramp-compat-replace-regexp-in-region - (regexp-quote - (tramp-compat-file-name-unquote - (file-name-as-directory localname))) + (rx (literal (tramp-compat-file-name-unquote + (file-name-as-directory localname)))) "" (point-min)) (widen))) (tramp-adb-sh-fix-ls-output) @@ -365,16 +362,12 @@ Emacs dired can't find files." (goto-char (point-min)) (while (search-forward-regexp - (eval-when-compile - (concat - "[[:space:]]" - "\\([[:space:]]" tramp-adb-ls-date-year-regexp "[[:space:]]\\)")) + (rx space (group space (regexp tramp-adb-ls-date-year-regexp) space)) nil t) (replace-match "0\\1" "\\1" nil) ;; Insert missing "/". (when (looking-at-p - (eval-when-compile - (concat tramp-adb-ls-date-time-regexp "[[:space:]]+$"))) + (rx (regexp tramp-adb-ls-date-time-regexp) (+ space) eol)) (end-of-line) (insert "/"))) ;; Sort entries. @@ -472,7 +465,8 @@ Emacs dired can't find files." (delq nil (mapcar - (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l)) + (lambda (l) + (and (not (string-match-p (rx bol (* space) eol) l)) l)) (split-string (buffer-string) "\n"))))))))))) (defun tramp-adb-handle-file-local-copy (filename) @@ -566,9 +560,10 @@ Emacs dired can't find files." ;; (introduced in POSIX.1-2008) fails. (tramp-adb-send-command-and-check v (format - (concat "touch -d %s %s %s 2>%s || " - "touch -d %s %s %s 2>%s || " - "touch -t %s %s %s") + (eval-when-compile + (concat "touch -d %s %s %s 2>%s || " + "touch -d %s %s %s 2>%s || " + "touch -t %s %s %s")) (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t) nofollow quoted-name (tramp-get-remote-null-device v) (format-time-string "%Y-%m-%dT%H:%M:%S" time t) @@ -723,10 +718,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar result 0) (dolist (line signals) (when (string-match - (concat - "^[[:space:]]*\\([[:digit:]]+\\)" - "[[:space:]]+\\S-+[[:space:]]+" - "\\([[:alpha:]].*\\)$") + (rx bol (* space) (group (+ digit)) + (+ space) (+ (not space)) + (+ space) (group alpha (* nonl)) eol) line) (setcar (nthcdr (string-to-number (match-string 1 line)) result) @@ -924,7 +918,7 @@ implementation will be used." (i 0) p) - (when (string-match-p "[[:multibyte:]]" command) + (when (string-match-p (rx multibyte) command) (tramp-error v 'file-error "Cannot apply multi-byte command `%s'" command)) @@ -997,7 +991,7 @@ implementation will be used." (while (progn (goto-char (point-min)) - (not (re-search-forward "[\n]" nil t))) + (not (search-forward "\n" nil t))) (tramp-accept-process-output p 0)) (delete-region (point-min) (point))) ;; Provide error buffer. This shows only @@ -1125,7 +1119,7 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (string-match-p "[[:multibyte:]]" command) + (if (string-match-p (rx multibyte) command) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1149,12 +1143,12 @@ error and non-nil on success." ;; We can't use stty to disable echo of command. stty is said ;; to be added to toybox 0.7.6. busybox shall have it, but this ;; isn't used any longer for Android. - (delete-matching-lines (regexp-quote command)) + (delete-matching-lines (rx (literal command))) ;; When the local machine is W32, there are still trailing ^M. ;; There must be a better solution by setting the correct coding ;; system, but this requires changes in core Tramp. (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) + (while (re-search-forward (rx (+ "\r") eol) nil t) (replace-match "" nil nil))))))) (defun tramp-adb-send-command-and-check (vec command &optional exit-status) @@ -1170,7 +1164,7 @@ the exit status." (format "%s; echo tramp_exit_status $?" command) "echo tramp_exit_status $?")) (with-current-buffer (tramp-get-connection-buffer vec) - (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+") + (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) (tramp-error vec 'file-error "Couldn't find exit status of `%s'" command)) (skip-chars-forward "^ ") @@ -1198,12 +1192,12 @@ FMT and ARGS are passed to `error'." (let ((inhibit-read-only t)) (goto-char (point-min)) ;; ADB terminal sends "^H" sequences. - (when (re-search-forward "<\b+" (point-at-eol) t) + (when (re-search-forward (rx "<" (+ "\b")) (line-end-position) t) (forward-line 1) (delete-region (point-min) (point))) ;; Delete the prompt. (goto-char (point-min)) - (when (re-search-forward prompt (point-at-eol) t) + (when (re-search-forward prompt (line-end-position) t) (forward-line 1) (delete-region (point-min) (point))) (when (tramp-search-regexp prompt) @@ -1232,7 +1226,7 @@ connection if a previous connection has died for some reason." ;; Maybe we know already that "su" is not supported. We cannot ;; use a connection property, because we have not checked yet ;; whether it is still the same device. - (when (and user (not (tramp-get-file-property vec "" "su-command-p" t))) + (when (and user (not (tramp-get-file-property vec "/" "su-command-p" t))) (tramp-error vec 'file-error "Cannot switch to user `%s'" user)) (unless (process-live-p p) @@ -1272,7 +1266,7 @@ connection if a previous connection has died for some reason." ;; Change prompt. (tramp-set-connection-property - p "prompt" (regexp-quote (format "///%s#$" prompt))) + p "prompt" (rx "///" (literal prompt) "#$")) (tramp-adb-send-command vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt)) @@ -1290,10 +1284,11 @@ connection if a previous connection has died for some reason." (tramp-message vec 5 "Checking system information") (tramp-adb-send-command vec - (concat - "echo \\\"`getprop ro.product.model` " - "`getprop ro.product.version` " - "`getprop ro.build.version.release`\\\"")) + (eval-when-compile + (concat + "echo \\\"`getprop ro.product.model` " + "`getprop ro.product.version` " + "`getprop ro.build.version.release`\\\""))) (let ((old-getprop (tramp-get-connection-property vec "getprop")) (new-getprop (tramp-set-connection-property @@ -1317,7 +1312,7 @@ connection if a previous connection has died for some reason." (unless (tramp-adb-send-command-and-check vec nil) (delete-process p) ;; Do not flush, we need the nil value. - (tramp-set-file-property vec "" "su-command-p" nil) + (tramp-set-file-property vec "/" "su-command-p" nil) (tramp-error vec 'file-error "Cannot switch to user `%s'" user))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 548999ca1d2..0d931b42da4 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -168,7 +168,8 @@ It must be supported by libarchive(3).") ;; <https://unix-memo.readthedocs.io/en/latest/vfs.html> -;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, mtree, iso9660, compress. +;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, +;; lzma, ar, mtree, iso9660, compress. ;; read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab. ;;;###autoload @@ -183,14 +184,17 @@ It must be supported by libarchive(3).") ;;;###autoload (progn (defmacro tramp-archive-autoload-file-name-regexp () "Regular expression matching archive file names." - '(concat - "\\`" "\\(" ".+" "\\." - ;; Default suffixes ... - (regexp-opt tramp-archive-suffixes) - ;; ... with compression. - "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" - "\\)" ;; \1 - "\\(" "/" ".*" "\\)" "\\'"))) ;; \2 + '(rx bos + ;; \1 + (group + (+ nonl) + ;; Default suffixes ... + "." (regexp (regexp-opt tramp-archive-suffixes)) + ;; ... with compression. + (? "." (regexp (regexp-opt tramp-archive-compression-suffixes)))) + ;; \2 + (group "/" (* nonl)) + eos))) (put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 289df2f9aad..6a3e60f7037 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -226,7 +226,8 @@ Return VALUE." (setq key (tramp-file-name-unify key file)) (dolist (property (hash-table-keys (tramp-get-hash-table key))) (when (string-match-p - "^\\(directory-\\|file-name-all-completions\\|file-entries\\)" + (rx + bos (| "directory-" "file-name-all-completions" "file-entries")) property) (tramp-flush-file-property key file property)))))) @@ -277,7 +278,7 @@ Remove also properties of all files in subdirectories." This is suppressed for temporary buffers." (save-match-data (unless (or (null (buffer-name)) - (string-match-p "^\\( \\|\\*\\)" (buffer-name))) + (string-match-p (rx bos (| " " "*")) (buffer-name))) (let ((bfn (if (stringp (buffer-file-name)) (buffer-file-name) default-directory)) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index f7704864ec6..a7ac1352665 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -34,6 +34,7 @@ (declare-function mml-mode "mml") (declare-function mml-insert-empty-tag "mml") (declare-function reporter-dump-variable "reporter") +(defvar mm-7bit-chars) (defvar reporter-eval-buffer) (defvar reporter-prompt-for-summary-p) @@ -502,7 +503,7 @@ This is needed if there are compatibility problems." ((dir (tramp-compat-funcall 'package-desc-dir (car (alist-get 'tramp (bound-and-true-p package-alist)))))) - (dolist (elc (directory-files dir 'full "\\.elc\\'")) + (dolist (elc (directory-files dir 'full (rx ".elc" eos))) (delete-file elc)) (with-current-buffer (get-buffer-create byte-compile-log-buffer) (let ((inhibit-read-only t)) @@ -604,7 +605,7 @@ buffer in your bug report. ;; There are non-7bit characters to be masked. (when (and (stringp val) (string-match-p - (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val)) + (rx-to-string `(not (any ,mm-7bit-chars))) val)) (with-current-buffer reporter-eval-buffer (set varsym `(decode-coding-string @@ -613,20 +614,21 @@ buffer in your bug report. 'raw-text))))) ;; Dump variable. - (reporter-dump-variable varsym mailbuf) + (goto-char (point-max)) + (save-excursion + (reporter-dump-variable varsym mailbuf)) (unless (hash-table-p val) ;; Remove string quotation. - (forward-line -1) (when (looking-at - (concat "\\(^.*\\)" "\"" ;; \1 " - "\\((base64-decode-string \\)" "\\\\" ;; \2 \ - "\\(\".*\\)" "\\\\" ;; \3 \ - "\\(\")\\)" "\"$")) ;; \4 " + (rx bol (group (* anychar)) "\"" ;; \1 " + (group "(base64-decode-string ") "\\" ;; \2 \ + (group "\"" (* anychar)) "\\" ;; \3 \ + (group "\")") "\"" eol)) ;; \4 " (replace-match "\\1\\2\\3\\4") (beginning-of-line) - (insert " ;; Variable encoded due to non-printable characters.\n")) - (forward-line 1)) + (insert " ;; Variable encoded due to non-printable characters.\n"))) + (goto-char (point-max)) ;; Reset VARSYM to old value. (with-current-buffer reporter-eval-buffer @@ -656,21 +658,27 @@ buffer in your bug report. (erase-buffer) (insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer))) (lisp-indent-line) - (dolist - (varsym - (sort - (append - (mapcar - #'intern - (all-completions "tramp-" (buffer-local-variables buffer))) - ;; Non-tramp variables of interest. - '(connection-local-variables-alist default-directory)) - #'string<)) - (reporter-dump-variable varsym elbuf)) + (dolist (varsym + (sort + (append + (mapcar + #'intern + (all-completions "tramp-" (buffer-local-variables buffer))) + ;; Non-tramp variables of interest. + '(connection-local-variables-alist default-directory)) + #'string<)) + (reporter-dump-variable varsym elbuf)) (lisp-indent-line) (insert ")\n")) (insert-buffer-substring elbuf))) + ;; Beautify encoded values. + (goto-char (point-min)) + (while (re-search-forward + (rx "'" (group "(decode-coding-string")) nil 'noerror) + (replace-match "\\1")) + (goto-char (point-max)) + ;; Dump load-path shadows. (insert "\nload-path shadows:\n==================\n") (ignore-errors @@ -683,7 +691,7 @@ buffer in your bug report. (eq major-mode 'message-mode) (bound-and-true-p mml-mode)) - (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/") + (let ((tramp-buf-regexp (rx "*" (? "debug ") "tramp/")) (buffer-list (tramp-list-tramp-buffers)) (curbuf (current-buffer))) @@ -694,7 +702,7 @@ buffer in your bug report. (setq buffer-read-only nil) (goto-char (point-min)) (while (not (eobp)) - (if (re-search-forward tramp-buf-regexp (point-at-eol) t) + (if (re-search-forward tramp-buf-regexp (line-end-position) t) (forward-line 1) (forward-line 0) (let ((start (point))) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 203d3ede98f..b7c0a3113ee 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -237,7 +237,7 @@ CONDITION can also be a list of error conditions." (lambda (from-string to-string in-string) (let (case-fold-search) (replace-regexp-in-string - (regexp-quote from-string) to-string in-string t t))))) + (rx (literal from-string)) to-string in-string t t))))) ;; Function `string-search' is new in Emacs 28.1. (defalias 'tramp-compat-string-search @@ -245,7 +245,7 @@ CONDITION can also be a list of error conditions." #'string-search (lambda (needle haystack &optional start-pos) (let (case-fold-search) - (string-match-p (regexp-quote needle) haystack start-pos))))) + (string-match-p (rx (literal needle)) haystack start-pos))))) ;; Function `make-lock-file-name' is new in Emacs 28.1. (defalias 'tramp-compat-make-lock-file-name diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 27b359d439b..e7bb1ebe338 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -426,7 +426,7 @@ Otherwise, return NAME." (if (directory-name-p name) #'file-name-as-directory #'identity) (concat dir - (unless (string-match-p (rx (seq bos (opt "/") eos)) localname) + (unless (string-match-p (rx bos (? "/") eos) localname) (with-tramp-file-property crypt-vec localname (concat (symbol-name op) "-file-name") (unless (tramp-crypt-send-command @@ -437,7 +437,7 @@ Otherwise, return NAME." (if (eq op 'encrypt) "Encoding" "Decoding") name)) (with-current-buffer (tramp-get-connection-buffer crypt-vec) (goto-char (point-min)) - (buffer-substring (point-min) (point-at-eol))))))) + (buffer-substring (point-min) (line-end-position))))))) ;; Nothing to do. name)) @@ -554,7 +554,7 @@ localname." (defun tramp-crypt-handle-access-file (filename string) "Like `access-file' for Tramp files." (let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename)) - (encrypt-regexp (concat (regexp-quote encrypt-filename) "\\'")) + (encrypt-regexp (rx (literal encrypt-filename) eos)) tramp-crypt-enabled) (condition-case err (access-file encrypt-filename string) @@ -706,7 +706,7 @@ absolute file names." (mapcar (lambda (x) (replace-regexp-in-string - (concat "^" (regexp-quote directory)) "" + (rx bos (literal directory)) "" (tramp-crypt-decrypt-file-name x))) (directory-files (tramp-crypt-encrypt-file-name directory) 'full))))) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index dd7e0f9f342..ad736256cab 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -97,9 +97,9 @@ present for backward compatibility." ;; Add some defaults for `tramp-default-method-alist'. (add-to-list 'tramp-default-method-alist - (list "\\`ftp\\." nil tramp-ftp-method)) + (list (rx bos "ftp.") nil tramp-ftp-method)) (add-to-list 'tramp-default-method-alist - (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method)) + (list nil (rx bos (| "anonymous" "ftp") eos) tramp-ftp-method)) ;; Add completion function for FTP method. (tramp-set-completion-function diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index 486a3cc57b7..4b51af070aa 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -51,7 +51,7 @@ "Remove hidden files from FILES." (if tramp-fuse-remove-hidden-files (cl-remove-if - (lambda (x) (and (stringp x) (string-match-p "\\.fuse_hidden" x))) + (lambda (x) (and (stringp x) (string-match-p (rx ".fuse_hidden") x))) files) files)) @@ -69,10 +69,10 @@ (tramp-fuse-local-file-name directory)))))))) (if full ;; Massage the result. - (let ((local (concat - "^" (regexp-quote - (tramp-fuse-mount-point - (tramp-dissect-file-name directory))))) + (let ((local (rx bol + (literal + (tramp-fuse-mount-point + (tramp-dissect-file-name directory))))) (remote (directory-file-name (funcall (if (tramp-compat-file-name-quoted-p directory) @@ -179,8 +179,7 @@ It has the same meaning as `remote-file-name-inhibit-cache'.") (tramp-set-file-property vec "/" "mounted" (when (string-match - (format - "^\\(%s\\)\\s-" (regexp-quote (tramp-fuse-mount-spec vec))) + (rx bol (group (literal (tramp-fuse-mount-spec vec))) space) mount) (match-string 1 mount))))))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ca5e959bea5..9060f37ed57 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -410,9 +410,9 @@ It has been changed in GVFS 1.14.") ;; </interface> (defconst tramp-goa-identity-regexp - (concat "^" "\\(" tramp-user-regexp "\\)?" - "@" "\\(" tramp-host-regexp "\\)?" - "\\(?:" ":""\\(" tramp-port-regexp "\\)" "\\)?") + (rx bol (? (group (regexp tramp-user-regexp))) + "@" (? (group (regexp tramp-host-regexp))) + (? ":" (group (regexp tramp-port-regexp)))) "Regexp matching GNOME Online Accounts \"PresentationIdentity\" property.") (defconst tramp-goa-interface-mail "org.gnome.OnlineAccounts.Mail" @@ -712,13 +712,13 @@ It has been changed in GVFS 1.14.") (eval-and-compile (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)") + (rx blank (group (regexp (regexp-opt tramp-gvfs-file-attributes))) + "=" (group (+? nonl))) "Regexp to parse GVFS file attributes with `gvfs-ls'.")) (defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp - (concat "^[[:blank:]]*" - (regexp-opt tramp-gvfs-file-attributes t) - ":[[:blank:]]+\\(.*\\)$") + (rx bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes))) + ":" (+ blank) (group (* nonl)) eol) "Regexp to parse GVFS file attributes with `gvfs-info'.") (defconst tramp-gvfs-file-system-attributes @@ -728,16 +728,16 @@ It has been changed in GVFS 1.14.") "GVFS file system attributes.") (defconst tramp-gvfs-file-system-attributes-regexp - (concat "^[[:blank:]]*" - (regexp-opt tramp-gvfs-file-system-attributes t) - ":[[:blank:]]+\\(.*\\)$") + (rx bol (* blank) + (group (regexp (regexp-opt tramp-gvfs-file-system-attributes))) + ":" (+ blank) (group (* nonl)) eol) "Regexp to parse GVFS file system attributes with `gvfs-info'.") (defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav" "Default prefix for owncloud / nextcloud methods.") (defconst tramp-gvfs-nextcloud-default-prefix-regexp - (concat (regexp-quote tramp-gvfs-nextcloud-default-prefix) "$") + (rx (literal tramp-gvfs-nextcloud-default-prefix) eol) "Regexp of default prefix for owncloud / nextcloud methods.") @@ -868,7 +868,7 @@ arguments to pass to the OPERATION." (defun tramp-gvfs-dbus-string-to-byte-array (string) "Like `dbus-string-to-byte-array' but add trailing \\0 if needed." (dbus-string-to-byte-array - (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature) (concat string (string 0)) string))) (defun tramp-gvfs-dbus-byte-array-to-string (byte-array) @@ -902,7 +902,7 @@ The call will be traced by Tramp with trace level 6." (let (result) (tramp-message vec 6 "%s" (cons func args)) (setq result (apply func args)) - (tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result)) + (tramp-message vec 6 "%s" (tramp-gvfs-stringify-dbus-message result)) result)) (put #'tramp-dbus-function 'tramp-suppress-trace t) @@ -1157,7 +1157,9 @@ file names." ;; Dissect NAME. (with-parsed-tramp-file-name name nil ;; If there is a default location, expand tilde. - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -1167,26 +1169,28 @@ file names." (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) - (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) + (string-prefix-p "~" localname)) (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; We do not pass "/..". - (if (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method) - (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname) + (if (string-match-p (rx bos (| "afp" (: "dav" (? "s")) "smb") eos) method) + (when (string-match + (rx bos "/" (+ (not (any "/"))) (group "/.." (? "/"))) + localname) (setq localname (replace-match "/" t t localname 1))) - (when (string-match "^/\\.\\./?" localname) + (when (string-match (rx bol "/.." (? "/")) localname) (setq localname (replace-match "/" t t localname)))) ;; There might be a double slash. Remove this. (while (string-match "//" localname) (setq localname (replace-match "/" t t localname))) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "/./" and "/../"), ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name - v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + v (if (string-prefix-p "~" localname) localname (tramp-run-real-handler #'expand-file-name (list localname))))))) @@ -1208,20 +1212,20 @@ file names." (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (looking-at - (eval-when-compile - (concat "^\\(.+\\)[[:blank:]]" - "\\([[:digit:]]+\\)[[:blank:]]" - "(\\(.+?\\))" - tramp-gvfs-file-attributes-with-gvfs-ls-regexp))) + (rx bol (group (+ nonl)) blank + (group (+ digit)) blank + "(" (group (+? nonl)) ")" + (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp))) (let ((item (list (cons "type" (match-string 3)) (cons "standard::size" (match-string 2)) (cons "name" (match-string 1))))) (goto-char (1+ (match-end 3))) (while (looking-at - (concat - tramp-gvfs-file-attributes-with-gvfs-ls-regexp - "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp - "\\|" "$" "\\)")) + (rx (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp) + (group + (| (regexp + tramp-gvfs-file-attributes-with-gvfs-ls-regexp) + eol)))) (push (cons (match-string 1) (match-string 2)) item) (goto-char (match-end 2))) ;; Add display name as head. @@ -1266,8 +1270,10 @@ If FILE-SYSTEM is non-nil, return file system attributes." (setq filename (directory-file-name (expand-file-name filename))) (with-parsed-tramp-file-name filename nil (setq localname (tramp-compat-file-name-unquote localname)) - (if (or (and (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method) - (string-match-p "^/?\\([^/]+\\)$" localname)) + (if (or (and (string-match-p + (rx bol (| "afp" (: "dav" (? "s")) "smb") eol) method) + (string-match-p + (rx bol (? "/") (+ (not (any "/"))) eol) localname)) (string-equal localname "/")) (tramp-gvfs-get-root-attributes filename) (assoc @@ -1297,7 +1303,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." ;; Convert them to multibyte. (decode-coding-string (replace-regexp-in-string - "\\\\x\\([[:xdigit:]]\\{2\\}\\)" + (rx "\\x" (group (= 2 xdigit))) (lambda (x) (unibyte-string (string-to-number (match-string 1 x) 16))) res-symlink-target) @@ -1467,7 +1473,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (let* ((events (process-get proc 'events)) (rest-string (process-get proc 'rest-string)) (dd (tramp-get-default-directory (process-buffer proc))) - (ddu (regexp-quote (tramp-gvfs-url-file-name dd)))) + (ddu (rx (literal (tramp-gvfs-url-file-name dd))))) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) @@ -1481,15 +1487,15 @@ If FILE-SYSTEM is non-nil, return file system attributes." "renamed to" "moved" string)) ;; https://bugs.launchpad.net/bugs/1742946 (when - (string-match-p "Monitoring not supported\\|No locations given" string) + (string-match-p + (rx (| "Monitoring not supported" "No locations given")) string) (delete-process proc)) (while (string-match - (eval-when-compile - (concat "^.+:" - "[[:space:]]\\(.+\\):" - "[[:space:]]" (regexp-opt tramp-gio-events t) - "\\([[:space:]]\\(.+\\)\\)?$")) + (rx bol (+ nonl) ":" + space (group (+ nonl)) ":" + space (group (regexp (regexp-opt tramp-gio-events))) + (? (group space (group (+ nonl)))) eol) string) (let ((file (match-string 1 string)) @@ -1499,11 +1505,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." ;; File names are returned as URL paths. We must convert them. (when (string-match ddu file) (setq file (replace-match dd nil nil file))) - (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" file) + (while (string-match-p (rx "%" (= 2 xdigit)) file) (setq file (url-unhex-string file))) (when (string-match ddu (or file1 "")) (setq file1 (replace-match dd nil nil file1))) - (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" (or file1 "")) + (while (string-match-p (rx "%" (= 2 xdigit)) (or file1 "")) (setq file1 (url-unhex-string file1))) ;; Remove watch when file or directory to be watched is deleted. (when (and (member action '(moved deleted)) @@ -1719,14 +1725,15 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-gvfs-file-name (object-path) "Retrieve file name from D-Bus OBJECT-PATH." (dbus-unescape-from-identifier - (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) + (replace-regexp-in-string + (rx bol (* nonl) "/" (+ (not (any "/"))) eol) "\\1" object-path))) (defun tramp-gvfs-url-host (url) "Return the host name part of URL, a string. We cannot use `url-host', because `url-generic-parse-url' returns a downcased host name only." (and (stringp url) - (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url) + (string-match (rx bol (+ alnum) "://" (group (+ (not (any "/:"))))) url) (match-string 1 url))) @@ -1739,7 +1746,8 @@ a downcased host name only." (pw-prompt (format "%s for %s " - (if (string-match "\\([pP]assword\\|[pP]assphrase\\)" message) + (if (string-match + (rx (group (any "Pp") (| "assword" "assphrase"))) message) (capitalize (match-string 1 message)) "Password") filename)) @@ -1861,7 +1869,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (cadr (assoc "ssl" (cadr mount-spec))))) (uri (tramp-gvfs-dbus-byte-array-to-string (cadr (assoc "uri" (cadr mount-spec)))))) - (when (string-match "^\\(afp\\|smb\\)" method) + (when (string-match (rx bol (group (| "afp" "smb"))) method) (setq method (match-string 1 method))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) @@ -1961,7 +1969,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (or (cadr (assoc "share" (cadr mount-spec))) (cadr (assoc "volume" (cadr mount-spec))))))) - (when (string-match "^\\(afp\\|smb\\)" method) + (when (string-match (rx bol (group (| "afp" "smb"))) method) (setq method (match-string 1 method))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) @@ -1993,7 +2001,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (string-equal domain (tramp-file-name-domain vec)) (string-equal host (tramp-file-name-host vec)) (string-equal port (tramp-file-name-port vec)) - (string-match-p (concat "^/" (regexp-quote (or share ""))) + (string-match-p (rx bol "/" (literal (or share ""))) (tramp-file-name-unquote-localname vec))) ;; Set mountpoint and location. (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) @@ -2019,7 +2027,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (defun tramp-gvfs-mount-spec-entry (key value) "Construct a mount-spec entry to be used in a mount_spec. It was \"a(say)\", but has changed to \"a{sv})\"." - (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature) (list :dict-entry key (list :variant (tramp-gvfs-dbus-string-to-byte-array value))) (list :struct key (tramp-gvfs-dbus-string-to-byte-array value)))) @@ -2037,9 +2045,11 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (port (if media (tramp-media-device-port media) (tramp-file-name-port vec))) (localname (tramp-file-name-unquote-localname vec)) - (share (when (string-match "^/?\\([^/]+\\)" localname) + (share (when (string-match + (rx bol (? "/") (group (+ (not (any "/"))))) localname) (match-string 1 localname))) - (ssl (if (string-match-p "^davs\\|^nextcloud" method) "true" "false")) + (ssl (if (string-match-p (rx bol (| "davs" "nextcloud")) method) + "true" "false")) (mount-spec `(:array ,@(cond @@ -2047,7 +2057,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "smb-share") (tramp-gvfs-mount-spec-entry "server" host) (tramp-gvfs-mount-spec-entry "share" share))) - ((string-match-p "^dav\\|^nextcloud" method) + ((string-match-p (rx bol (| "davs" "nextcloud")) method) (list (tramp-gvfs-mount-spec-entry "type" "dav") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "ssl" ssl))) @@ -2061,7 +2071,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ((string-equal "nextcloud" method) (list (tramp-gvfs-mount-spec-entry "type" "owncloud") (tramp-gvfs-mount-spec-entry "host" host))) - ((string-match-p "^http" method) + ((string-match-p (rx bol "http") method) (list (tramp-gvfs-mount-spec-entry "type" "http") (tramp-gvfs-mount-spec-entry "uri" @@ -2078,8 +2088,8 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ,@(when port (list (tramp-gvfs-mount-spec-entry "port" port))))) (mount-pref - (if (and (string-match-p "^dav" method) - (string-match "^/?[^/]+" localname)) + (if (and (string-match-p (rx bol "dav") method) + (string-match (rx bol (? "/") (+ (not (any "/")))) localname)) (match-string 0 localname) (tramp-gvfs-get-remote-prefix vec)))) @@ -2166,7 +2176,7 @@ connection if a previous connection has died for some reason." (string-equal localname "/")) (tramp-user-error vec "Filename must contain an AFP volume")) - (when (and (string-match-p "davs?" method) + (when (and (string-match-p (rx "dav" (? "s")) method) (string-equal localname "/")) (tramp-user-error vec "Filename must contain a WebDAV share")) @@ -2216,7 +2226,7 @@ connection if a previous connection has died for some reason." ;; The call must be asynchronously, because of the "askPassword" ;; or "askQuestion" callbacks. - (if (string-match-p "(so)$" tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx "(so)" eol) tramp-gvfs-mountlocation-signature) (with-tramp-dbus-call-method vec nil :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation @@ -2446,7 +2456,7 @@ It checks for mounted media devices." (text (zeroconf-service-txt x)) user) (when port - (setq host (format "%s%s%d" host tramp-prefix-port-regexp port))) + (setq host (format "%s%s%d" host tramp-prefix-port-format port))) ;; A user is marked in a TXT field like "u=guest". (while text (when (string-match "u=\\(.+\\)$" (car text)) @@ -2462,7 +2472,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." (ignore-errors (split-string (shell-command-to-string (format "avahi-browse -trkp %s" service)) - "[\n\r]+" 'omit "^\\+;.*$")))) + (rx (+ (any "\r\n"))) 'omit (rx bol "+;" (* nonl) eol))))) (delete-dups (mapcar (lambda (x) @@ -2472,7 +2482,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." user) ;; A user is marked in a TXT field like "u=guest". (while text - (when (string-match "u=\\(.+\\)$" (car text)) + (when (string-match (rx "u=" (group (+ nonl)) eol) (car text)) (setq user (match-string 1 (car text)))) (setq text (cdr text))) (list user host))) diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 226113d8800..946f9725022 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -85,7 +85,8 @@ special handling of `substitute-in-file-name'." (defun tramp-rfn-eshadow-update-overlay-regexp () "An overlay covering the shadowed part of the filename." - (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format)) + (rx-to-string + `(: (* (not (any ,tramp-postfix-host-format "/~"))) (or "/" "~")))) (defun tramp-rfn-eshadow-update-overlay () "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. @@ -215,9 +216,13 @@ NAME must be equal to `tramp-current-connection'." ;; Create a pseudo mode `tramp-info-lookup-mode' for Tramp symbol lookup. (info-lookup-maybe-add-help :mode 'tramp-info-lookup-mode :topic 'symbol - :regexp "[^][()`'‘’,\" \t\n]+" - :doc-spec '(("(tramp)Function Index" nil "^ -+ .*: " "\\( \\|$\\)") - ("(tramp)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)"))) + :regexp (rx (+ (not (any "\t\n \"'(),[]`‘’")))) + :doc-spec '(("(tramp)Function Index" nil + (rx bol " " (+ "-") " " (* nonl) ": ") + (rx (group (| " " eol)))) + ("(tramp)Variable Index" nil + (rx bol " " (+ "-") " " (* nonl) ": ") + (rx (group (| " " eol)))))) (add-hook 'tramp-integration-unload-hook diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 5bee5641bb1..435faf83294 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -186,7 +186,7 @@ arguments to pass to the OPERATION." (delq nil (mapcar (lambda (line) - (when (string-match "^\\(\\S-+\\):$" line) + (when (string-match (rx bol (group (+ (not space))) ":" eol) line) `(nil ,(match-string 1 line)))) (tramp-process-lines nil tramp-rclone-program "listremotes"))))) @@ -300,11 +300,11 @@ file names." (let (total used free) (goto-char (point-min)) (while (not (eobp)) - (when (looking-at "Total: [[:space:]]+\\([[:digit:]]+\\)") + (when (looking-at (rx "Total: " (+ space) (group (+ digit)))) (setq total (string-to-number (match-string 1)))) - (when (looking-at "Used: [[:space:]]+\\([[:digit:]]+\\)") + (when (looking-at (rx "Used: " (+ space) (group (+ digit)))) (setq used (string-to-number (match-string 1)))) - (when (looking-at "Free: [[:space:]]+\\([[:digit:]]+\\)") + (when (looking-at (rx "Free: " (+ space) (group (+ digit)))) (setq free (string-to-number (match-string 1)))) (forward-line)) (when used @@ -343,7 +343,7 @@ file names." (tramp-rclone-maybe-open-connection v) ;; TODO: This shall be handled by `expand-file-name'. (setq localname - (replace-regexp-in-string "^\\." "" (or localname ""))) + (replace-regexp-in-string (rx bol ".") "" (or localname ""))) (format "%s%s" (tramp-fuse-mounted-p v) localname))) ;; It is a local file name. filename)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 4a9cf2e6997..2489ac9aec9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -81,10 +81,10 @@ the default storage location, e.g. \"$HOME/.sh_history\"." (string :tag "Redirect to a file"))) ;;;###tramp-autoload -(defconst tramp-display-escape-sequence-regexp "\e[[:digit:];[]+m" +(defconst tramp-display-escape-sequence-regexp (rx "\e" (+ (any ";[" digit)) "m") "Terminal control escape sequences for display attributes.") -(defconst tramp-device-escape-sequence-regexp "\e[[:digit:][]+n" +(defconst tramp-device-escape-sequence-regexp (rx "\e" (+ (any "[" digit)) "n") "Terminal control escape sequences for device status.") ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for @@ -411,19 +411,19 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-default-method-alist `(,tramp-local-host-regexp - ,(format "\\`%s\\'" tramp-root-id-string) "su")) + ,(rx bos (literal tramp-root-id-string) eos) "su")) (add-to-list 'tramp-default-user-alist - `(,(concat "\\`" (regexp-opt '("su" "sudo" "doas" "ksu")) "\\'") + `(,(rx bos (regexp (regexp-opt '("su" "sudo" "doas" "ksu"))) eos) nil ,tramp-root-id-string)) ;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored. ;; Do not add "plink" based methods, they ask interactively for the user. (add-to-list 'tramp-default-user-alist - `(,(concat - "\\`" - (regexp-opt - '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")) - "\\'") + `(,(rx bos + (regexp + (regexp-opt + '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))) + eos) nil ,(user-login-name)))) ;;;###tramp-autoload @@ -518,8 +518,8 @@ The string is used in `tramp-methods'.") (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)) (defcustom tramp-sh-extra-args - '(("/bash\\'" . "-noediting -norc -noprofile") - ("/zsh\\'" . "-f +Z -V")) + `((,(rx "/bash" eos) . "-noediting -norc -noprofile") + (,(rx "/zsh" eos) . "-f +Z -V")) "Alist specifying extra arguments to pass to the remote shell. Entries are (REGEXP . ARGS) where REGEXP is a regular expression matching the shell file name and ARGS is a string specifying the @@ -1188,7 +1188,7 @@ component is used as the target of the symlink." (tramp-shell-quote-argument localname))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (buffer-substring (point-min) (point-at-eol)))) + (buffer-substring (point-min) (line-end-position)))) ;; Use Perl implementation. ((and (tramp-get-remote-perl v) @@ -1334,7 +1334,7 @@ component is used as the target of the symlink." (setq res-symlink-target (if (looking-at-p "\"") (read (current-buffer)) - (buffer-substring (point) (point-at-eol))))) + (buffer-substring (point) (line-end-position))))) (forward-line) ;; ... file mode flags (read (current-buffer)) @@ -1416,7 +1416,7 @@ component is used as the target of the symlink." (format "%s -ild %s" (tramp-get-ls-command v) (tramp-shell-quote-argument localname))) - (setq attr (buffer-substring (point) (point-at-eol)))) + (setq attr (buffer-substring (point) (line-end-position)))) (tramp-set-file-property v localname "visited-file-modtime-ild" attr)) (setq last-coding-system-used coding-system-used) @@ -1460,7 +1460,7 @@ of." (tramp-get-ls-command v) (tramp-shell-quote-argument localname))) (with-current-buffer (tramp-get-buffer v) - (setq attr (buffer-substring (point) (point-at-eol)))) + (setq attr (buffer-substring (point) (line-end-position)))) (equal attr (tramp-get-file-property @@ -1517,7 +1517,7 @@ VEC or USER, or if there is no home directory, return nil." (concat "~" (or user (tramp-file-name-user vec)))))) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (buffer-substring (point) (point-at-eol))))) + (buffer-substring (point) (line-end-position))))) (defun tramp-sh-handle-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. @@ -1572,8 +1572,10 @@ ID-FORMAT valid values are `string' and `integer'." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):" - "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)"))) + (regexp (rx (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum)))))) (when (and (tramp-remote-selinux-p v) (tramp-send-command-and-check v (format @@ -1582,7 +1584,7 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-shell-quote-argument localname)))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (when (re-search-forward regexp (point-at-eol) t) + (when (re-search-forward regexp (line-end-position) t) (setq context (list (match-string 1) (match-string 2) (match-string 3) (match-string 4)))))) ;; Return the context. @@ -1723,7 +1725,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; On BSD-derived systems files always inherit the ;; parent directory's group, so skip the group-gid ;; test. - (tramp-check-remote-uname v "BSD\\|DragonFly\\|Darwin") + (tramp-check-remote-uname v (rx (| "BSD" "DragonFly" "Darwin"))) (= (file-attribute-group-id attributes) (tramp-get-remote-gid v 'integer))))))))) @@ -1809,7 +1811,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; Check result code, found in last line of output. (forward-line -1) - (if (looking-at-p "^fail$") + (if (looking-at-p (rx bol "fail" eol)) (progn ;; Grab error message from line before last line ;; (it was put there by `cd 2>&1'). @@ -1817,12 +1819,12 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-error v 'file-error "tramp-sh-handle-file-name-all-completions: %s" - (buffer-substring (point) (point-at-eol)))) + (buffer-substring (point) (line-end-position)))) ;; For peace of mind, if buffer doesn't end in `fail' ;; then it should end in `ok'. If neither are in the ;; buffer something went seriously wrong on the remote ;; side. - (unless (looking-at-p "^ok$") + (unless (looking-at-p (rx bol "ok" eol)) (tramp-error v 'file-error (concat "tramp-sh-handle-file-name-all-completions: " @@ -1830,7 +1832,7 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-shell-quote-argument localname) (buffer-string)))) (while (zerop (forward-line -1)) - (push (buffer-substring (point) (point-at-eol)) result))) + (push (buffer-substring (point) (line-end-position)) result))) result)))))) ;; cp, mv and ln @@ -2550,7 +2552,7 @@ The method used must be an out-of-band method." (with-tramp-progress-reporter v 0 (format "Uncompressing %s" file) (when (tramp-send-command-and-check - v (if (string-match-p "%[io]" (nth 2 suffix)) + v (if (string-match-p (rx "%" (any "io")) (nth 2 suffix)) (replace-regexp-in-string "%i" (tramp-shell-quote-argument localname) (nth 2 suffix)) @@ -2659,7 +2661,9 @@ The method used must be an out-of-band method." (save-restriction (narrow-to-region beg-marker end-marker) ;; Check for "--dired" output. - (when (re-search-backward "^//DIRED//\\s-+\\(.+\\)$" nil 'noerror) + (when (re-search-backward + (rx bol "//DIRED//" (+ space) (group (+ nonl)) eol) + nil 'noerror) (let ((beg (match-beginning 1)) (end (match-end 0))) ;; Now read the numeric positions of file names. @@ -2731,7 +2735,7 @@ The method used must be an out-of-band method." ;; Try to insert the amount of free space. (goto-char (point-min)) ;; First find the line to put it on. - (when (and (re-search-forward "^\\([[:space:]]*total\\)" nil t) + (when (and (re-search-forward (rx bol (group (* space) "total")) nil t) ;; Emacs 29.1 or later. (not (fboundp 'dired--insert-disk-space))) (when-let ((available (get-free-disk-space "."))) @@ -2758,7 +2762,7 @@ the result will be a local, non-Tramp, file name." ;; by `file-name-absolute-p'. (if (and (eq system-type 'windows-nt) (string-match-p - (concat "^\\([[:alpha:]]:\\|" null-device "$\\)") name)) + (rx bol (| (: alpha ":") (: (literal null-device) eol))) name)) (tramp-run-real-handler #'expand-file-name (list name dir)) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) @@ -2774,7 +2778,9 @@ the result will be a local, non-Tramp, file name." ;; groks tilde expansion! The function `tramp-find-shell' is ;; supposed to find such a shell on the remote host. Please ;; tell me about it when this doesn't work on your system. - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -2785,7 +2791,7 @@ the result will be a local, non-Tramp, file name." ;; appropriate either, because ssh and companions might ;; use a user name from the config file. (when (and (zerop (length uname)) - (string-match-p "\\`su\\(do\\)?\\'" method)) + (string-match-p (rx bos "su" (? "do") eos) method)) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -2794,7 +2800,7 @@ the result will be a local, non-Tramp, file name." (while (string-match "//" localname) (setq localname (replace-match "/" t t localname))) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "/./" and "/../"), ;; unless there are tilde characters in file name. @@ -2802,9 +2808,9 @@ the result will be a local, non-Tramp, file name." ;; would be problems with UNC shares or Cygwin mounts. (let ((default-directory tramp-compat-temporary-file-directory)) (tramp-make-tramp-file-name - v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) - localname - (tramp-drop-volume-letter + v (tramp-drop-volume-letter + (if (string-prefix-p "~" localname) + localname (tramp-run-real-handler #'expand-file-name (list localname)))))))))) @@ -2884,11 +2890,12 @@ implementation will be used." ;; command. (heredoc (and (not (bufferp stderr)) (stringp program) - (string-match-p "sh$" program) + (string-match-p (rx "sh" eol) program) (= (length args) 2) (string-equal "-c" (car args)) ;; Don't if there is a quoted string. - (not (string-match-p "'\\|\"" (cadr args))) + (not + (string-match-p (rx (any "'\"")) (cadr args))) ;; Check, that /dev/tty is usable. (tramp-get-remote-dev-tty v))) ;; When PROGRAM is nil, we just provide a tty. @@ -3093,7 +3100,7 @@ implementation will be used." (let (signal-hook-function) (condition-case nil (dolist (sig (cdr signals)) - (unless (string-match-p "^[[:alnum:]+-]+$" sig) + (unless (string-match-p (rx bol (+ (any "+-" alnum)) eol) sig) (error nil))) (error (setq signals '(0))))) (dotimes (i 128) @@ -3124,7 +3131,8 @@ implementation will be used." (tramp-shell-quote-argument (format "kill -%d $$" i)))) (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) - (buffer-substring (point-at-bol) (point-at-eol))))) + (buffer-substring (line-beginning-position) + (line-end-position))))) (if (string-empty-p res) (format "Signal %d" i) res))) @@ -3269,81 +3277,84 @@ implementation will be used." (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." (tramp-skeleton-file-local-copy filename - (if-let ((size (file-attribute-size (file-attributes filename))) - (rem-enc (tramp-get-inline-coding v "remote-encoding" size)) - (loc-dec (tramp-get-inline-coding v "local-decoding" size))) + (if-let ((size (file-attribute-size (file-attributes filename)))) + (let (rem-enc loc-dec) - (condition-case err - (cond - ;; Empty file. - ((zerop size)) - - ;; `copy-file' handles direct copy and out-of-band methods. - ((or (tramp-local-host-p v) - (tramp-method-out-of-band-p v size)) - (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)) - - ;; Use inline encoding for file transfer. - (rem-enc - (with-tramp-progress-reporter - v 3 - (format-message - "Encoding remote file `%s' with `%s'" filename rem-enc) - (tramp-barf-unless-okay - v (format rem-enc (tramp-shell-quote-argument localname)) - "Encoding remote file failed")) - - ;; Check error. `rem-enc' could be a pipe, which doesn't - ;; flag the error in the first command. - (when (zerop (buffer-size (tramp-get-buffer v))) - (tramp-error v 'file-error' "Encoding remote file failed")) + (condition-case err + (cond + ;; Empty file. Nothing to copy. + ((zerop size)) + + ;; `copy-file' handles direct copy and out-of-band methods. + ((or (tramp-local-host-p v) + (tramp-method-out-of-band-p v size)) + (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)) + + ;; Use inline encoding for file transfer. + ((and (setq rem-enc + (tramp-get-inline-coding v "remote-encoding" size)) + (setq loc-dec + (tramp-get-inline-coding v "local-decoding" size))) + (with-tramp-progress-reporter + v 3 + (format-message + "Encoding remote file `%s' with `%s'" filename rem-enc) + (tramp-barf-unless-okay + v (format rem-enc (tramp-shell-quote-argument localname)) + "Encoding remote file failed")) + + ;; Check error. `rem-enc' could be a pipe, which + ;; doesn't flag the error in the first command. + (when (zerop (buffer-size (tramp-get-buffer v))) + (tramp-error v 'file-error' "Encoding remote file failed")) + + (with-tramp-progress-reporter + v 3 (format-message + "Decoding local file `%s' with `%s'" tmpfile loc-dec) + (if (functionp loc-dec) + ;; If local decoding is a function, we call it. + ;; We must disable multibyte, because + ;; `uudecode-decode-region' doesn't handle it + ;; correctly. Unset `file-name-handler-alist'. + ;; Otherwise, epa-file gets confused. + (let (file-name-handler-alist + (coding-system-for-write 'binary) + (default-directory + tramp-compat-temporary-file-directory)) + (with-temp-file tmpfile + (set-buffer-multibyte nil) + (insert-buffer-substring (tramp-get-buffer v)) + (funcall loc-dec (point-min) (point-max)))) + + ;; If tramp-decoding-function is not defined for + ;; this method, we invoke tramp-decoding-command + ;; instead. + (let ((tmpfile2 (tramp-compat-make-temp-file filename))) + ;; Unset `file-name-handler-alist'. Otherwise, + ;; epa-file gets confused. + (let (file-name-handler-alist + (coding-system-for-write 'binary)) + (with-current-buffer (tramp-get-buffer v) + (write-region + (point-min) (point-max) tmpfile2 nil 'no-message))) + (unwind-protect + (tramp-call-local-coding-command + loc-dec tmpfile2 tmpfile) + (delete-file tmpfile2))))) + + ;; Set proper permissions. + (set-file-modes tmpfile (tramp-default-file-modes filename)) + ;; Set local user ownership. + (tramp-set-file-uid-gid tmpfile)) + + ;; Oops, I don't know what to do. + (t (tramp-error + v 'file-error "Wrong method specification for `%s'" method))) - (with-tramp-progress-reporter - v 3 (format-message - "Decoding local file `%s' with `%s'" tmpfile loc-dec) - (if (functionp loc-dec) - ;; If local decoding is a function, we call it. We - ;; must disable multibyte, because - ;; `uudecode-decode-region' doesn't handle it - ;; correctly. Unset `file-name-handler-alist'. - ;; Otherwise, epa-file gets confused. - (let (file-name-handler-alist - (coding-system-for-write 'binary) - (default-directory - tramp-compat-temporary-file-directory)) - (with-temp-file tmpfile - (set-buffer-multibyte nil) - (insert-buffer-substring (tramp-get-buffer v)) - (funcall loc-dec (point-min) (point-max)))) - - ;; If tramp-decoding-function is not defined for this - ;; method, we invoke tramp-decoding-command instead. - (let ((tmpfile2 (tramp-compat-make-temp-file filename))) - ;; Unset `file-name-handler-alist'. Otherwise, - ;; epa-file gets confused. - (let (file-name-handler-alist - (coding-system-for-write 'binary)) - (with-current-buffer (tramp-get-buffer v) - (write-region - (point-min) (point-max) tmpfile2 nil 'no-message))) - (unwind-protect - (tramp-call-local-coding-command - loc-dec tmpfile2 tmpfile) - (delete-file tmpfile2))))) - - ;; Set proper permissions. - (set-file-modes tmpfile (tramp-default-file-modes filename)) - ;; Set local user ownership. - (tramp-set-file-uid-gid tmpfile)) - - ;; Oops, I don't know what to do. - (t (tramp-error - v 'file-error "Wrong method specification for `%s'" method))) - - ;; Error handling. - ((error quit) - (delete-file tmpfile) - (signal (car err) (cdr err)))) + ;; Error handling. + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err))))) ;; Impossible to copy. Trigger `file-missing' error. (setq tmpfile nil)))) @@ -3806,8 +3817,8 @@ Fall back to normal file name handler if no Tramp handler exists." (catch 'doesnt-work ;; https://bugs.launchpad.net/bugs/1742946 - (when - (string-match-p "Monitoring not supported\\|No locations given" string) + (when (string-match-p + (rx (| "Monitoring not supported" "No locations given")) string) (delete-process proc) (throw 'doesnt-work nil)) @@ -3825,9 +3836,11 @@ Fall back to normal file name handler if no Tramp handler exists." ((getenv "EMACS_EMBA_CI") 'GInotifyFileMonitor) ((eq system-type 'cygwin) 'GPollFileMonitor))) ;; TODO: What happens, if several monitor names are reported? - ((string-match "\ -Supported arguments for GIO_USE_FILE_MONITOR environment variable: -\\s-*\\([[:alpha:]]+\\) - 20" string) + ((string-match + (rx "Supported arguments for " + "GIO_USE_FILE_MONITOR environment variable:\n" + (* space) (group (+ alpha)) " - 20") + string) (setq pos (match-end 0)) (intern (format "G%sFileMonitor" (capitalize (match-string 1 string))))) @@ -3838,15 +3851,14 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: (setq string (tramp-compat-string-replace "\n\n" "\n" string)) (while (string-match - (eval-when-compile - (concat "^[^:]+:" - "[[:space:]]\\([^:]+\\):" - "[[:space:]]" (regexp-opt tramp-gio-events t) - "\\([[:space:]]\\([^:]+\\)\\)?$")) + (rx bol (+ (not (any ":"))) ":" space + (group (+ (not (any ":")))) ":" space + (group (regexp (regexp-opt tramp-gio-events))) + (? space (group (+ (not (any ":"))))) eol) string) (let* ((file (match-string 1 string)) - (file1 (match-string 4 string)) + (file1 (match-string 3 string)) (object (list proc @@ -3866,7 +3878,7 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: `(file-notify ,object file-notify-callback)))))) ;; Save rest of the string. - (while (string-match "^\n" string) + (while (string-match (rx bol "\n") string) (setq string (replace-match "" nil nil string))) (when (zerop (length string)) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) @@ -3879,9 +3891,8 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: (dolist (line (split-string string "[\n\r]+" 'omit)) ;; Check, whether there is a problem. (unless (string-match - (concat "^[^[:blank:]]+" - "[[:blank:]]+\\([^[:blank:]]+\\)" - "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") + (rx bol (+ (not blank)) (+ blank) (group (+ (not blank))) + (? (+ blank) (group (+ (not (any "\r\n")))))) line) (tramp-error proc 'file-notify-error line)) @@ -3893,7 +3904,7 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: (intern-soft (tramp-compat-string-replace "_" "-" (downcase x)))) (split-string (match-string 1 line) "," 'omit)) - (or (match-string 3 line) + (or (match-string 2 line) (file-name-nondirectory (process-get proc 'watch-name)))))) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at @@ -3917,10 +3928,10 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: (goto-char (point-min)) (forward-line) (when (looking-at - (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?" - "[[:space:]]*\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)")) + (rx (? bol "/" (* (not space)) space) (* space) + (group (+ digit)) (+ space) + (group (+ digit)) (+ space) + (group (+ digit)))) (mapcar (lambda (d) (* d (tramp-get-connection-property v "df-blocksize" 0))) @@ -3942,49 +3953,51 @@ by \"2>/dev/null\", and \"%t\" is replaced by a temporary file name. If VEC is nil, the respective local commands are used. If there is a format specifier which cannot be expanded, this function returns nil." - (if (not (string-match-p "\\(^\\|[^%]\\)%[ahlnoprst]" script)) + (if (not (string-match-p + (rx (| bol (not (any "%"))) "%" (any "ahlnoprst")) script)) script (catch 'wont-work - (let ((awk (when (string-match-p "\\(^\\|[^%]\\)%a" script) + (let ((awk (when (string-match-p (rx (| bol (not (any "%"))) "%a") script) (or (if vec (tramp-get-remote-awk vec) (executable-find "awk")) (throw 'wont-work nil)))) - (hdmp (when (string-match-p "\\(^\\|[^%]\\)%h" script) + (hdmp (when (string-match-p (rx (| bol (not (any "%"))) "%h") script) (or (if vec (tramp-get-remote-hexdump vec) (executable-find "hexdump")) (throw 'wont-work nil)))) - (dev (when (string-match-p "\\(^\\|[^%]\\)%n" script) + (dev (when (string-match-p (rx (| bol (not (any "%"))) "%n") script) (or (if vec (concat "2>" (tramp-get-remote-null-device vec)) (if (eq system-type 'windows-nt) "" (concat "2>" null-device))) (throw 'wont-work nil)))) - (ls (when (string-match-p "\\(^\\|[^%]\\)%l" script) + (ls (when (string-match-p (rx (| bol (not (any "%"))) "%l") script) (format "%s %s" (or (tramp-get-ls-command vec) (throw 'wont-work nil)) (tramp-sh--quoting-style-options vec)))) - (od (when (string-match-p "\\(^\\|[^%]\\)%o" script) + (od (when (string-match-p (rx (| bol (not (any "%"))) "%o") script) (or (if vec (tramp-get-remote-od vec) (executable-find "od")) (throw 'wont-work nil)))) - (perl (when (string-match-p "\\(^\\|[^%]\\)%p" script) + (perl (when (string-match-p (rx (| bol (not (any "%"))) "%p") script) (or (if vec (tramp-get-remote-perl vec) (executable-find "perl")) (throw 'wont-work nil)))) - (readlink (when (string-match-p "\\(^\\|[^%]\\)%r" script) - (or - (if vec + (readlink (when (string-match-p + (rx (| bol (not (any "%"))) "%r") script) + (or + (if vec (tramp-get-remote-readlink vec) (executable-find "readlink")) (throw 'wont-work nil)))) - (stat (when (string-match-p "\\(^\\|[^%]\\)%s" script) + (stat (when (string-match-p (rx (| bol (not (any "%"))) "%s") script) (or (if vec (tramp-get-remote-stat vec) (executable-find "stat")) (throw 'wont-work nil)))) - (tmp (when (string-match-p "\\(^\\|[^%]\\)%t" script) + (tmp (when (string-match-p (rx (| bol (not (any "%"))) "%t") script) (or (if vec (tramp-file-local-name (tramp-make-tramp-temp-name vec)) @@ -4057,7 +4070,7 @@ This function expects to be in the right *tramp* buffer." (unless (or ignore-path (tramp-check-remote-uname vec tramp-sunos-unames)) (tramp-send-command vec (format "which \\%s | wc -w" progname)) (goto-char (point-min)) - (if (looking-at-p "^\\s-*1$") + (if (looking-at-p (rx bol (* space) "1" eol)) (setq result (concat "\\" progname)))) (unless result (when ignore-tilde @@ -4084,7 +4097,7 @@ This function expects to be in the right *tramp* buffer." (when (search-backward "tramp_executable " nil t) (skip-chars-forward "^ ") (skip-chars-forward " ") - (setq result (buffer-substring (point) (point-at-eol))))) + (setq result (buffer-substring (point) (line-end-position))))) result))) ;; On hydra.nixos.org, the $PATH environment variable is too long to @@ -4097,7 +4110,8 @@ whether it exists and if so, it is added to the environment variable PATH." (let ((command (format - "PATH=%s && export PATH" (string-join (tramp-get-remote-path vec) ":"))) + "PATH=%s && export PATH" + (string-join (tramp-get-remote-path vec) ":"))) (pipe-buf (with-tramp-connection-property vec "pipe-buf" (tramp-send-command-and-read @@ -4223,9 +4237,10 @@ file exists and nonzero exit status otherwise." ;; first. (tramp-send-command vec (format - (concat - "exec env TERM='%s' INSIDE_EMACS='%s' " - "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i") + (eval-when-compile + (concat + "exec env TERM='%s' INSIDE_EMACS='%s' " + "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i")) tramp-terminal-type (tramp-inside-emacs) (or (getenv-internal "ENV" tramp-remote-process-environment) "") (if (stringp tramp-histfile-override) @@ -4240,16 +4255,21 @@ file exists and nonzero exit status otherwise." ;; Sanity check. (tramp-barf-if-no-shell-prompt - (tramp-get-connection-process vec) 10 + (tramp-get-connection-process vec) 60 "Couldn't find remote shell prompt for %s" shell) (unless (tramp-check-for-regexp - (tramp-get-connection-process vec) (regexp-quote tramp-end-of-output)) + (tramp-get-connection-process vec) (rx (literal tramp-end-of-output))) + (tramp-wait-for-output (tramp-get-connection-process vec)) (tramp-message vec 5 "Setting shell prompt") (tramp-send-command vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''" (tramp-shell-quote-argument tramp-end-of-output)) - t)) + t t) + (tramp-barf-if-no-shell-prompt + (tramp-get-connection-process vec) 60 + "Couldn't find remote shell prompt for %s" shell)) + (tramp-wait-for-output (tramp-get-connection-process vec)) ;; Check proper HISTFILE setting. We give up when not working. (when (and (stringp tramp-histfile-override) @@ -4280,7 +4300,8 @@ file exists and nonzero exit status otherwise." (tramp-send-command vec (format "echo ~%s" tramp-root-id-string) t) (if (or (string-match-p - (format "^~%s$" tramp-root-id-string) (buffer-string)) + (rx bol "~" (literal tramp-root-id-string) eol) + (buffer-string)) ;; The default shell (ksh93) of OpenSolaris ;; and Solaris is buggy. We've got reports ;; for "SunOS 5.10" and "SunOS 5.11" so far. @@ -4295,9 +4316,10 @@ file exists and nonzero exit status otherwise." default-shell (tramp-message vec 2 - (concat - "Couldn't find a remote shell which groks tilde " - "expansion, using `%s'") + (eval-when-compile + (concat + "Couldn't find a remote shell which groks tilde " + "expansion, using `%s'")) default-shell))) default-shell))) @@ -4318,8 +4340,9 @@ seconds. If not, it produces an error message with the given ERROR-ARGS." (condition-case nil (tramp-wait-for-regexp proc timeout - (format - "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) + (rx (| (regexp shell-prompt-pattern) + (regexp tramp-shell-prompt-pattern)) + eos)) (error (delete-process proc) (apply #'tramp-error-with-buffer @@ -4388,7 +4411,8 @@ process to set up. VEC specifies the connection." (string-prefix-p "Darwin" uname) (cons 'utf-8-hfs 'utf-8-hfs)) (and (memq 'utf-8 (coding-system-list)) - (string-match-p "utf-?8" (tramp-get-remote-locale vec)) + (string-match-p + (rx "utf" (? "-") "8") (tramp-get-remote-locale vec)) (cons 'utf-8 'utf-8)) (process-coding-system proc) (cons 'undecided 'undecided))) @@ -4420,7 +4444,7 @@ process to set up. VEC specifies the connection." (t (tramp-message vec 5 "Checking remote host type for `send-process-string' bug") - (if (string-match-p "FreeBSD\\|DragonFly" uname) 500 0)))) + (if (string-match-p (rx (| "FreeBSD" "DragonFly")) uname) 500 0)))) ;; Set remote PATH variable. (tramp-set-remote-path vec) @@ -4452,7 +4476,7 @@ process to set up. VEC specifies the connection." (tramp-send-command vec "set +H" t)) ;; Disable tab expansion. - (if (string-match-p "BSD\\|DragonFly\\|Darwin" uname) + (if (string-match-p (rx (| "BSD" "DragonFly" "Darwin")) uname) (tramp-send-command vec "stty tabs" t) (tramp-send-command vec "stty tab0" t)) @@ -4678,7 +4702,7 @@ Goes through the list `tramp-local-coding-commands' and (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) - (unless (looking-at-p (regexp-quote magic)) + (unless (looking-at-p (rx (literal magic))) (throw 'wont-work-remote nil))) ;; `rem-enc' and `rem-dec' could be a string meanwhile. @@ -4764,7 +4788,7 @@ Goes through the list `tramp-inline-compress-commands'." nil t)) (throw 'next nil)) (goto-char (point-min)) - (unless (looking-at-p (regexp-quote magic)) + (unless (looking-at-p (rx (literal magic))) (throw 'next nil))) (tramp-message vec 5 @@ -4775,7 +4799,7 @@ Goes through the list `tramp-inline-compress-commands'." (throw 'next nil)) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (unless (looking-at-p (regexp-quote magic)) + (unless (looking-at-p (rx (literal magic))) (throw 'next nil))) (setq found t))) @@ -4864,7 +4888,7 @@ Goes through the list `tramp-inline-compress-commands'." (goto-char (point-min)) (unless (search-forward-regexp - "\\(illegal\\|unknown\\) option -- T" nil t) + (rx (| "illegal" "unknown") " option -- T") nil t) (setq tramp-scp-strict-file-name-checking "-T"))))))) tramp-scp-strict-file-name-checking))) @@ -4891,7 +4915,7 @@ Goes through the list `tramp-inline-compress-commands'." (goto-char (point-min)) (unless (search-forward-regexp - "\\(illegal\\|unknown\\) option -- O" nil t) + (rx (| "illegal" "unknown") " option -- O") nil t) (setq tramp-scp-force-scp-protocol "-O"))))))) tramp-scp-force-scp-protocol))) @@ -4914,7 +4938,7 @@ Goes through the list `tramp-inline-compress-commands'." (tramp-call-process vec1 "scp" nil t nil "-R") (goto-char (point-min)) (not (search-forward-regexp - "\\(illegal\\|unknown\\) option -- R" nil 'noerror))))) + (rx (| "illegal" "unknown") " option -- R") nil 'noerror))))) ;; Check, that RemoteCommand is not used. (with-tramp-connection-property @@ -4955,7 +4979,10 @@ Goes through the list `tramp-inline-compress-commands'." (line-beginning-position) (line-end-position)) string (and - (string-match "^[^# ]+ \\S-+ \\(\\S-+\\)$" string) + (string-match + (rx bol (+ (not (any " #"))) " " (+ (not space)) " " + (group (+ (not space))) eol) + string) (match-string 1 string)) found (and string @@ -5260,20 +5287,22 @@ function waits for output unless NOOUTPUT is set." ;; Busyboxes built with the EDITING_ASK_TERMINAL config ;; option send also escape sequences, which must be ;; ignored. - (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$" - (regexp-quote tramp-end-of-output) - tramp-device-escape-sequence-regexp)) + (regexp (rx (* (not (any "#$\n"))) + (literal tramp-end-of-output) + (? (regexp tramp-device-escape-sequence-regexp)) + (? "\r") eol)) ;; Sometimes, the commands do not return a newline but a ;; null byte before the shell prompt, for example "git ;; ls-files -c -z ...". - (regexp1 (format "\\(^\\|\000\\)%s" regexp)) + (regexp1 (rx (| bol "\000") (regexp regexp))) (found (tramp-wait-for-regexp proc timeout regexp1))) (if found (let ((inhibit-read-only t)) ;; A simple-minded busybox has sent " ^H" sequences. ;; Delete them. (goto-char (point-min)) - (when (re-search-forward "^\\(.\b\\)+$" (point-at-eol) t) + (when (re-search-forward + (rx bol (+ nonl "\b") eol) (line-end-position) t) (forward-line 1) (delete-region (point-min) (point))) ;; Delete the prompt. @@ -5304,7 +5333,9 @@ Optional argument EXIT-STATUS, if non-nil, triggers the return of the exit status." (let (cmd data) (if (and (stringp command) - (string-match (format ".*<<'%s'.*" tramp-end-of-heredoc) command)) + (string-match + (rx (* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl)) + command)) (setq cmd (match-string 0 command) data (substring command (match-end 0))) (setq cmd command)) @@ -5320,7 +5351,7 @@ the exit status." (if subshell " )" "") data))) (with-current-buffer (tramp-get-connection-buffer vec) - (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+") + (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) (tramp-error vec 'file-error "Couldn't find exit status of `%s'" command)) (skip-chars-forward "^ ") @@ -5365,7 +5396,7 @@ raises an error." (unless noerror signal-hook-function))) (read (current-buffer))) ;; Error handling. - (when (re-search-forward "\\S-" (point-at-eol) t) + (when (re-search-forward (rx (not space)) (line-end-position) t) (error nil))) (error (unless noerror (tramp-error @@ -5395,7 +5426,7 @@ raises an error." ;; This does not work for MS Windows scp, if there are characters ;; to be quoted. OpenSSH 8 supports disabling of strict file name ;; checking in scp, we use it when available. - (unless (string-match-p "ftp$" method) + (unless (string-match-p (rx "ftp" eos) method) (setq localname (tramp-unquote-shell-quote-argument localname))) (cond ((tramp-get-method-parameter vec 'tramp-remote-copy-program) @@ -5473,7 +5504,7 @@ Nonexistent directories are removed from spec." (tramp-get-method-parameter vec 'tramp-remote-shell-args) " ") (tramp-shell-quote-argument tramp-end-of-heredoc)) - 'noerror (regexp-quote tramp-end-of-heredoc)) + 'noerror (rx (literal tramp-end-of-heredoc))) (progn (tramp-message vec 2 "Could not retrieve `tramp-own-remote-path'") @@ -5522,8 +5553,9 @@ Nonexistent directories are removed from spec." (with-current-buffer (tramp-get-connection-buffer vec) (while candidates (goto-char (point-min)) - (if (string-match-p (format "^%s\r?$" (regexp-quote (car candidates))) - (buffer-string)) + (if (string-match-p + (rx bol (literal (car candidates))"%s" (? "\r") eol) + (buffer-string)) (setq locale (car candidates) candidates nil) (setq candidates (cdr candidates))))) @@ -5553,7 +5585,7 @@ Nonexistent directories are removed from spec." "%s --color=never -al %s" result (tramp-get-remote-null-device vec))) (not (string-match-p - (regexp-quote "\e") + "\e" (tramp-get-buffer-string (tramp-get-buffer vec))))) (setq result (concat result " --color=never"))) @@ -5601,7 +5633,7 @@ Nonexistent directories are removed from spec." vec (format "( %s / -nt / )" (tramp-get-test-command vec))) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (when (looking-at-p (regexp-quote tramp-end-of-output)) + (when (looking-at-p (rx (literal tramp-end-of-output))) (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) (progn (tramp-send-command @@ -5666,7 +5698,9 @@ Nonexistent directories are removed from spec." tmp (tramp-send-command-and-read vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror)) (unless (and (listp tmp) (stringp (car tmp)) - (string-match-p "^[\"`‘„”«「]/[\"'’“”»」]$" (car tmp)) + (string-match-p + (rx bol (any "\"`'‘„”«「") "/" (any "\"'’“”»」") eol) + (car tmp)) (integerp (cadr tmp))) (setq result nil))) result)))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a81a8f13636..9e63d532626 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -53,7 +53,7 @@ ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-default-user-alist - `(,(concat "\\`" tramp-smb-method "\\'") nil nil)) + `(,(rx bos (literal tramp-smb-method) eos) nil nil)) ;; Add completion function for SMB method. (tramp-set-completion-function @@ -92,10 +92,15 @@ this variable \"client min protocol=NT1\"." "Version string of the SMB client.") (defconst tramp-smb-server-version - "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" + (rx "Domain=[" (* (not (any "]"))) "] " + "OS=[" (* (not (any "]"))) "] " + "Server=[" (* (not (any "]"))) "]") "Regexp of SMB server identification.") -(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$" +(defconst tramp-smb-prompt + (rx bol (| (: (| "smb:" "PS") " " (+ nonl) "> ") + (: (+ space) "Server" + (+ space) "Comment" eol))) "Regexp used as prompt in smbclient or powershell.") (defconst tramp-smb-wrong-passwd-regexp @@ -105,66 +110,63 @@ this variable \"client min protocol=NT1\"." "Regexp for login error strings of SMB servers.") (defconst tramp-smb-errors - (mapconcat - #'identity - `(;; Connection error / timeout / unknown command. - "Connection\\( to \\S-+\\)? failed" - "Read from server failed, maybe it closed the connection" - "Call timed out: server did not respond" - "\\S-+: command not found" - "Server doesn't support UNIX CIFS calls" - ,(regexp-opt - '(;; Samba. - "ERRDOS" - "ERRHRD" - "ERRSRV" - "ERRbadfile" - "ERRbadpw" - "ERRfilexists" - "ERRnoaccess" - "ERRnomem" - "ERRnosuchshare" - ;; See /usr/include/samba-4.0/core/ntstatus.h. - ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), - ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), - ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7), - ;; Windows 6.3 (Windows Server 2012, Windows 10). - "NT_STATUS_ACCESS_DENIED" - "NT_STATUS_ACCOUNT_LOCKED_OUT" - "NT_STATUS_BAD_NETWORK_NAME" - "NT_STATUS_CANNOT_DELETE" - "NT_STATUS_CONNECTION_DISCONNECTED" - "NT_STATUS_CONNECTION_REFUSED" - "NT_STATUS_CONNECTION_RESET" - "NT_STATUS_DIRECTORY_NOT_EMPTY" - "NT_STATUS_DUPLICATE_NAME" - "NT_STATUS_FILE_IS_A_DIRECTORY" - "NT_STATUS_HOST_UNREACHABLE" - "NT_STATUS_IMAGE_ALREADY_LOADED" - "NT_STATUS_INVALID_LEVEL" - "NT_STATUS_INVALID_PARAMETER" - "NT_STATUS_INVALID_PARAMETER_MIX" - "NT_STATUS_IO_TIMEOUT" - "NT_STATUS_LOGON_FAILURE" - "NT_STATUS_NETWORK_ACCESS_DENIED" - "NT_STATUS_NOT_IMPLEMENTED" - "NT_STATUS_NO_LOGON_SERVERS" - "NT_STATUS_NO_SUCH_FILE" - "NT_STATUS_NO_SUCH_USER" - "NT_STATUS_NOT_A_DIRECTORY" - "NT_STATUS_NOT_SUPPORTED" - "NT_STATUS_OBJECT_NAME_COLLISION" - "NT_STATUS_OBJECT_NAME_INVALID" - "NT_STATUS_OBJECT_NAME_NOT_FOUND" - "NT_STATUS_OBJECT_PATH_SYNTAX_BAD" - "NT_STATUS_PASSWORD_MUST_CHANGE" - "NT_STATUS_RESOURCE_NAME_NOT_FOUND" - "NT_STATUS_REVISION_MISMATCH" - "NT_STATUS_SHARING_VIOLATION" - "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" - "NT_STATUS_UNSUCCESSFUL" - "NT_STATUS_WRONG_PASSWORD"))) - "\\|") + (rx (| ;; Connection error / timeout / unknown command. + (: "Connection" (? " to " (+ (not space))) " failed") + "Read from server failed, maybe it closed the connection" + "Call timed out: server did not respond" + (: (+ (not space)) ": command not found") + "Server doesn't support UNIX CIFS calls" + (regexp (regexp-opt + '(;; Samba. + "ERRDOS" + "ERRHRD" + "ERRSRV" + "ERRbadfile" + "ERRbadpw" + "ERRfilexists" + "ERRnoaccess" + "ERRnomem" + "ERRnosuchshare" + ;; See /usr/include/samba-4.0/core/ntstatus.h. + ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), + ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), + ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7), + ;; Windows 6.3 (Windows Server 2012, Windows 10). + "NT_STATUS_ACCESS_DENIED" + "NT_STATUS_ACCOUNT_LOCKED_OUT" + "NT_STATUS_BAD_NETWORK_NAME" + "NT_STATUS_CANNOT_DELETE" + "NT_STATUS_CONNECTION_DISCONNECTED" + "NT_STATUS_CONNECTION_REFUSED" + "NT_STATUS_CONNECTION_RESET" + "NT_STATUS_DIRECTORY_NOT_EMPTY" + "NT_STATUS_DUPLICATE_NAME" + "NT_STATUS_FILE_IS_A_DIRECTORY" + "NT_STATUS_HOST_UNREACHABLE" + "NT_STATUS_IMAGE_ALREADY_LOADED" + "NT_STATUS_INVALID_LEVEL" + "NT_STATUS_INVALID_PARAMETER" + "NT_STATUS_INVALID_PARAMETER_MIX" + "NT_STATUS_IO_TIMEOUT" + "NT_STATUS_LOGON_FAILURE" + "NT_STATUS_NETWORK_ACCESS_DENIED" + "NT_STATUS_NOT_IMPLEMENTED" + "NT_STATUS_NO_LOGON_SERVERS" + "NT_STATUS_NO_SUCH_FILE" + "NT_STATUS_NO_SUCH_USER" + "NT_STATUS_NOT_A_DIRECTORY" + "NT_STATUS_NOT_SUPPORTED" + "NT_STATUS_OBJECT_NAME_COLLISION" + "NT_STATUS_OBJECT_NAME_INVALID" + "NT_STATUS_OBJECT_NAME_NOT_FOUND" + "NT_STATUS_OBJECT_PATH_SYNTAX_BAD" + "NT_STATUS_PASSWORD_MUST_CHANGE" + "NT_STATUS_RESOURCE_NAME_NOT_FOUND" + "NT_STATUS_REVISION_MISMATCH" + "NT_STATUS_SHARING_VIOLATION" + "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" + "NT_STATUS_UNSUCCESSFUL" + "NT_STATUS_WRONG_PASSWORD"))))) "Regexp for possible error strings of SMB servers. Used instead of analyzing error codes of commands.") @@ -727,7 +729,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Dissect NAME. (with-parsed-tramp-file-name name nil ;; Tilde expansion if necessary. - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -737,17 +741,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) - (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) + (string-prefix-p "~" localname)) (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "/./" and "/../"), ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name - v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + v (if (string-prefix-p "~" localname) localname (tramp-run-real-handler #'expand-file-name (list localname))))))) @@ -765,10 +769,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (widen) (tramp-message vec 10 "\n%s" (buffer-string)) (goto-char (point-min)) - (while (and (not (eobp)) (not (looking-at-p "^REVISION:"))) + (while (and (not (eobp)) (not (looking-at-p (rx bol "REVISION:")))) (forward-line) (delete-region (point-min) (point))) - (while (and (not (eobp)) (looking-at-p "^.+:.+")) + (while (and (not (eobp)) (looking-at-p (rx bol (+ nonl) ":" (+ nonl)))) (forward-line)) (delete-region (point) (point-max)) (throw 'tramp-action 'ok)))) @@ -882,29 +886,30 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (while (not (eobp)) (cond ((looking-at - (concat - "Size:\\s-+\\([[:digit:]]+\\)\\s-+" - "Blocks:\\s-+[[:digit:]]+\\s-+\\(\\w+\\)")) + (rx "Size:" (+ space) (group (+ digit)) (+ space) + "Blocks:" (+ space) (+ digit) (+ space) (group (+ wordchar)))) (setq size (string-to-number (match-string 1)) id (if (string-equal "directory" (match-string 2)) t (if (string-equal "symbolic" (match-string 2)) "")))) ((looking-at - "Inode:\\s-+\\([[:digit:]]+\\)\\s-+Links:\\s-+\\([[:digit:]]+\\)") + (rx "Inode:" (+ space) (group (+ digit)) (+ space) + "Links:" (+ space) (group (+ digit)))) (setq inode (string-to-number (match-string 1)) link (string-to-number (match-string 2)))) ((looking-at - (concat - "Access:\\s-+([[:digit:]]+/\\(\\S-+\\))\\s-+" - "Uid:\\s-+\\([[:digit:]]+\\)\\s-+" - "Gid:\\s-+\\([[:digit:]]+\\)")) + (rx "Access:" (+ space) + "(" (+ digit) "/" (group (+ (not space))) ")" (+ space) + "Uid:" (+ space) (group (+ digit)) (+ whitespace) + "Gid:" (+ space) (group (+ digit)))) (setq mode (match-string 1) uid (match-string 2) gid (match-string 3))) ((looking-at - (concat - "Access:\\s-+" - "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+" - "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)")) + (rx "Access:" (+ space) + (group (+ digit)) "-" (group (+ digit)) "-" + (group (+ digit)) (+ space) + (group (+ digit)) ":" (group (+ digit)) ":" + (group (+ digit)))) (setq atime (encode-time (string-to-number (match-string 6)) ;; sec @@ -914,10 +919,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-to-number (match-string 2)) ;; month (string-to-number (match-string 1))))) ;; year ((looking-at - (concat - "Modify:\\s-+" - "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+" - "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)")) + (rx "Modify:" (+ space) + (group (+ digit)) "-" (group (+ digit)) "-" + (group (+ digit)) (+ space) + (group (+ digit)) ":" (group (+ digit)) ":" + (group (+ digit)))) (setq mtime (encode-time (string-to-number (match-string 6)) ;; sec @@ -927,10 +933,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-to-number (match-string 2)) ;; month (string-to-number (match-string 1))))) ;; year ((looking-at - (concat - "Change:\\s-+" - "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+" - "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)")) + (rx "Change:" (+ space) + (group (+ digit)) "-" (group (+ digit)) "-" + (group (+ digit)) (+ space) + (group (+ digit)) ":" (group (+ digit)) ":" + (group (+ digit)))) (setq ctime (encode-time (string-to-number (match-string 6)) ;; sec @@ -948,7 +955,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (format "readlink %s" (tramp-smb-shell-quote-localname vec)))) (goto-char (point-min)) - (and (looking-at ".+ -> \\(.+\\)") + (and (looking-at (rx (+ nonl) " -> " (group (+ nonl)))) (setq id (match-string 1)))) ;; Return the result. @@ -1003,14 +1010,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (goto-char (point-min)) (forward-line) (when (looking-at - (concat "[[:space:]]*\\([[:digit:]]+\\)" - " blocks of size \\([[:digit:]]+\\)" - "\\. \\([[:digit:]]+\\) blocks available")) + (rx (* space) (group (+ digit)) + " blocks of size " (group (+ digit)) + ". " (group (+ digit)) " blocks available")) (setq blocksize (string-to-number (match-string 2)) total (* blocksize (string-to-number (match-string 1))) avail (* blocksize (string-to-number (match-string 3))))) (forward-line) - (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)") + (when (looking-at (rx "Total number of bytes: " (group (+ digit)))) ;; The used number of bytes is not part of the result. ;; As side effect, we store it as file property. (tramp-set-file-property @@ -1061,11 +1068,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (/ (tramp-get-file-property v localname "used-bytes" 0) 1024)))) (when wildcard - (string-match "\\." base) + (string-match (rx ".") base) (setq base (replace-match "\\\\." nil nil base)) - (string-match "\\*" base) + (string-match (rx "*") base) (setq base (replace-match ".*" nil nil base)) - (string-match "\\?" base) + (string-match (rx "?") base) (setq base (replace-match ".?" nil nil base))) ;; Filter entries. @@ -1076,7 +1083,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Check for matching entries. (mapcar (lambda (x) - (when (string-match-p (format "^%s" base) (nth 0 x)) x)) + (when (string-match-p (rx bol (literal base)) (nth 0 x)) + x)) entries) ;; We just need the only and only entry FILENAME. (list (assoc base entries))))) @@ -1486,7 +1494,7 @@ component is used as the target of the symlink." ;; the function. No error is propagated outside, ;; due to the `ignore-errors' closure. (unless - (tramp-search-regexp "tramp_exit_status [[:digit:]]+") + (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) (tramp-error v 'file-error "Couldn't find exit status of `%s'" @@ -1577,7 +1585,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." filename (with-parsed-tramp-file-name filename nil ;; Ignore in LOCALNAME everything before "//". - (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) + (when (and (stringp localname) + (string-match (rx (+? nonl) "/" (group (| "/" "~"))) localname)) (setq filename (concat (file-remote-p filename) (replace-match "\\1" nil nil localname))))) @@ -1623,7 +1632,8 @@ VEC or USER, or if there is no home directory, return nil." "Return the share name of LOCALNAME." (save-match-data (let ((localname (tramp-file-name-unquote-localname vec))) - (when (string-match "^/?\\([^/]+\\)/" localname) + (when (string-match + (rx bol (? "/") (group (+ (not (any "/")))) "/") localname) (match-string 1 localname))))) (defun tramp-smb-get-localname (vec) @@ -1633,7 +1643,8 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (let ((localname (tramp-file-name-unquote-localname vec))) (setq localname - (if (string-match "^/?[^/]+\\(/.*\\)" localname) + (if (string-match + (rx bol (? "/") (+ (not (any "/"))) (group "/" (* nonl))) localname) ;; There is a share, separated by "/". (if (not (tramp-smb-get-cifs-capabilities vec)) (mapconcat @@ -1641,16 +1652,17 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (match-string 1 localname) "") (match-string 1 localname)) ;; There is just a share. - (if (string-match "^/?\\([^/]+\\)$" localname) + (if (string-match + (rx bol (? "/") (group (+ (not (any "/")))) eol) localname) (match-string 1 localname) ""))) ;; Sometimes we have discarded `substitute-in-file-name'. - (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname) + (when (string-match (rx (group "$$") (group (| "/" eol))) localname) (setq localname (replace-match "$" nil nil localname 1))) ;; A trailing space is not supported. - (when (string-match-p " $" localname) + (when (string-match-p (rx " " eol) localname) (tramp-error vec 'file-error "Invalid file name %s" (tramp-make-tramp-file-name vec localname))) @@ -1763,13 +1775,14 @@ If SHARE is result, entries are of type dir. Otherwise, shares are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." ;; We are called from `tramp-smb-get-file-entries', which sets the ;; current buffer. - (let ((line (buffer-substring (point) (point-at-eol))) + (let ((line (buffer-substring (point) (line-end-position))) localname mode size month day hour min sec year mtime) (if (not share) ;; Read share entries. - (when (string-match "^Disk|\\([^|]+\\)|" line) + (when (string-match + (rx bol "Disk|" (group (+ (not (any "|")))) "|") line) (setq localname (match-string 1 line) mode "dr-xr-xr-x" size 0)) @@ -1778,14 +1791,17 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-block nil ;; year. - (if (string-match "\\([[:digit:]]+\\)$" line) + (if (string-match (rx (group (+ digit)) eol) line) (setq year (string-to-number (match-string 1 line)) line (substring line 0 -5)) (cl-return)) ;; time. (if (string-match - "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)$" line) + (rx (group (+ digit)) ":" + (group (+ digit)) ":" + (group (+ digit)) eol) + line) (setq hour (string-to-number (match-string 1 line)) min (string-to-number (match-string 2 line)) sec (string-to-number (match-string 3 line)) @@ -1793,28 +1809,28 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-return)) ;; day. - (if (string-match "\\([[:digit:]]+\\)$" line) + (if (string-match (rx (group (+ digit)) eol) line) (setq day (string-to-number (match-string 1 line)) line (substring line 0 -3)) (cl-return)) ;; month. - (if (string-match "\\(\\w+\\)$" line) + (if (string-match (rx (group (+ wordchar)) eol) line) (setq month (match-string 1 line) line (substring line 0 -4)) (cl-return)) ;; weekday. - (if (string-match-p "\\(\\w+\\)$" line) + (if (string-match-p (rx (group (+ wordchar)) eol) line) (setq line (substring line 0 -5)) (cl-return)) ;; size. - (if (string-match "\\([[:digit:]]+\\)$" line) + (if (string-match (rx (group (+ digit)) eol) line) (let ((length (- (max 10 (1+ (length (match-string 1 line))))))) (setq size (string-to-number (match-string 1 line))) (when (string-match - "\\([ACDEHNORrsSTV]+\\)" (substring line length)) + (rx (+ (any "ACDEHNORSTVrs"))) (substring line length)) (setq length (+ length (match-end 0)))) (setq line (substring line 0 length))) (cl-return)) @@ -1823,7 +1839,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." ;; NONINDEXED, NORMAL, OFFLINE, READONLY, ;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID. - (if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line) + (if (string-match (rx (? (group (+ (any "ACDEHNORSTVrs")))) eol) line) (setq mode (or (match-string 1 line) "") mode (format @@ -1838,7 +1854,11 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-return)) ;; localname. - (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line) + (if (string-match + (rx bol (+ space) + (group (not space) (? (group (* nonl) (not space)))) + (* space) eol) + line) (setq localname (match-string 1 line)) (cl-return)))) @@ -1877,7 +1897,8 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (member "pathnames" (split-string - (buffer-substring (point) (point-at-eol)) nil 'omit))))))))) + (buffer-substring (point) (line-end-position)) + nil 'omit))))))))) (defun tramp-smb-get-stat-capability (vec) "Check whether the SMB server supports the `stat' command." @@ -1927,7 +1948,7 @@ If ARGUMENT is non-nil, use it as argument for (setq tramp-smb-version (shell-command-to-string command)) (tramp-message vec 6 command) (tramp-message vec 6 "\n%s" tramp-smb-version) - (if (string-match "[ \t\n\r]+\\'" tramp-smb-version) + (if (string-match (rx (+ (any " \t\n\r")) eos) tramp-smb-version) (setq tramp-smb-version (replace-match "" nil nil tramp-smb-version)))) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index a9225db434e..31720a605ec 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -215,7 +215,7 @@ arguments to pass to the OPERATION." (progn ;; Read the expression. (goto-char (point-min)) - (buffer-substring (point) (point-at-eol))) + (buffer-substring (point) (line-end-position))) ":" 'omit)))) ;; The equivalent to `exec-directory'. `(,(tramp-file-local-name (expand-file-name default-directory))))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 0de2e0ef69a..893afcdbbee 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -49,7 +49,8 @@ (tramp-password-previous-hop t))) (add-to-list 'tramp-default-user-alist - `("\\`sudoedit\\'" nil ,tramp-root-id-string)) + `(,(rx bos (literal tramp-sudoedit-method) eos) + nil ,tramp-root-id-string)) (tramp-set-completion-function tramp-sudoedit-method tramp-completion-function-alist-su)) @@ -374,7 +375,9 @@ the result will be a local, non-Tramp, file name." (setq localname "~")) (unless (file-name-absolute-p localname) (setq localname (format "~%s/%s" user localname))) - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -383,11 +386,11 @@ the result will be a local, non-Tramp, file name." (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../"). (tramp-make-tramp-file-name - v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + v (if (string-prefix-p "~" localname) localname (tramp-run-real-handler #'expand-file-name (list localname)))))) @@ -470,7 +473,7 @@ the result will be a local, non-Tramp, file name." (delq nil (mapcar - (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l)) + (lambda (l) (and (not (string-match-p (rx bol (* space) eol) l)) l)) (split-string (tramp-get-buffer-string (tramp-get-connection-buffer v)) "\n" 'omit)))))))) @@ -504,15 +507,17 @@ the result will be a local, non-Tramp, file name." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):" - "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)"))) + (regexp (rx (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum)))))) (when (and (tramp-sudoedit-remote-selinux-p v) (tramp-sudoedit-send-command v "ls" "-d" "-Z" (tramp-compat-file-name-unquote localname))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (when (re-search-forward regexp (point-at-eol) t) + (when (re-search-forward regexp (line-end-position) t) (setq context (list (match-string 1) (match-string 2) (match-string 3) (match-string 4)))))) ;; Return the context. @@ -530,9 +535,9 @@ the result will be a local, non-Tramp, file name." (goto-char (point-min)) (forward-line) (when (looking-at - (concat "[[:space:]]*\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)")) + (rx (* space) (group (+ digit)) + (+ space) (group (+ digit)) + (+ space) (group (+ digit)))) (list (string-to-number (match-string 1)) ;; The second value is the used size. We need the ;; free size. @@ -752,7 +757,7 @@ ID-FORMAT valid values are `string' and `integer'." (delete-region (point-min) (point)) ;; Delete empty lines. (goto-char (point-min)) - (while (and (not (eobp)) (= (point) (point-at-eol))) + (while (and (not (eobp)) (= (point) (line-end-position))) (forward-line)) (delete-region (point-min) (point)) (tramp-message vec 3 "Process has finished.") @@ -841,7 +846,7 @@ In case there is no valid Lisp expression, it raises an error." (condition-case nil (prog1 (read (current-buffer)) ;; Error handling. - (when (re-search-forward "\\S-" (point-at-eol) t) + (when (re-search-forward (rx (not space)) (line-end-position) t) (error nil))) (error (tramp-error vec 'file-error @@ -855,7 +860,7 @@ In case there is no valid Lisp expression, it raises an error." (tramp-message vec 6 "\n%s" (buffer-string)) (goto-char (point-max)) ;(delete-blank-lines) - (while (looking-back "[ \t\n]+" nil 'greedy) + (while (looking-back (rx (+ (any " \t\n"))) nil 'greedy) (delete-region (match-beginning 0) (point))) (when (> (point-max) (point-min)) (substring-no-properties (buffer-string)))))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ed40245e8a0..bb6eeaa7417 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -64,7 +64,8 @@ (declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) -;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ELPA package. +;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU +;; ELPA package. ;;;###autoload (when (featurep 'tramp-compat) ;;;###autoload (load "tramp-compat" 'noerror 'nomessage)) @@ -514,10 +515,10 @@ interpreted as a regular expression which always matches." ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>. (defcustom tramp-restricted-shell-hosts-alist (when (and (eq system-type 'windows-nt) - (not (string-match-p "sh$" tramp-encoding-shell))) - (list (format "\\`\\(%s\\|%s\\)\\'" - (regexp-quote (downcase tramp-system-name)) - (regexp-quote (upcase tramp-system-name))))) + (not (string-match-p (rx "sh" eol) tramp-encoding-shell))) + (list (rx bos (group (| (literal (downcase tramp-system-name)) + (literal (upcase tramp-system-name)))) + eos))) "List of hosts, which run a restricted shell. This is a list of regular expressions, which denote hosts running a restricted shell like \"rbash\". Those hosts can be used as @@ -528,12 +529,11 @@ host runs a restricted shell, it shall be added to this list, too." ;;;###tramp-autoload (defcustom tramp-local-host-regexp - (concat - "\\`" - (regexp-opt - `("localhost" "localhost4" "localhost6" ,tramp-system-name "127.0.0.1" "::1") - t) - "\\'") + (rx bos + (regexp (regexp-opt + `("localhost" "localhost4" "localhost6" + ,tramp-system-name "127.0.0.1" "::1"))) + eos) "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." :version "29.1" @@ -580,8 +580,9 @@ followed by an equal number of backspaces to erase them will usually suffice.") (defconst tramp-echoed-echo-mark-regexp - (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}" - tramp-echo-mark-marker tramp-echo-mark-marker-length) + (rx-to-string + `(: ,tramp-echo-mark-marker + (= ,tramp-echo-mark-marker-length (group "\b" (? " \b"))))) "Regexp which matches `tramp-echo-mark' as it gets echoed by \ the remote shell.") @@ -598,7 +599,7 @@ if you need to change this." :type 'string) (defcustom tramp-login-prompt-regexp - ".*\\(user\\|login\\)\\( .*\\)?: *" + (rx (* nonl) (group (| "user" "login")) (? (group " " (* nonl))) ":" (* " ")) "Regexp matching login-like prompts. The regexp should match at end of buffer. @@ -610,8 +611,11 @@ Sometimes the prompt is reported to look like \"login as:\"." ;; displayed at the beginning of the line (and Zsh uses it). ;; Allow also [] style prompts. They can appear only during ;; connection initialization; Tramp redefines the prompt afterwards. - (concat "\\(?:^\\|\r\\)" - "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[[:digit:];]*[[:alpha:]] *\\)*") + (rx (| bol "\r") + (* (not (any "\n#$%>]"))) + (? "#") (any "#$%>]") (* space) + ;; Escape characters. + (* "[" (* (any ";" digit)) alpha (* space))) "Regexp to match prompts from remote shell. Normally, Tramp expects you to configure `shell-prompt-pattern' correctly, but sometimes it happens that you are connecting to a @@ -626,7 +630,9 @@ This regexp must match both `tramp-initial-end-of-output' and :type 'regexp) (defcustom tramp-password-prompt-regexp - (format "^.*\\(%s\\).*:\^@? *" (regexp-opt password-word-equivalents)) + (rx bol (* nonl) + (group (regexp (regexp-opt password-word-equivalents))) + (* nonl) ":" (? "\^@") (* space)) "Regexp matching password-like prompts. The regexp should match at end of buffer. @@ -640,36 +646,26 @@ The `sudo' program appears to insert a `^@' character into the prompt." :type 'regexp) (defcustom tramp-wrong-passwd-regexp - (concat "^.*" - ;; These strings should be on the last line - (regexp-opt '("Permission denied" - "Login incorrect" - "Login Incorrect" - "Connection refused" - "Connection closed" - "Timeout, server not responding." - "Sorry, try again." - "Name or service not known" - "Host key verification failed." - "No supported authentication methods left to try!") - t) - ".*" - "\\|" - "^.*\\(" - ;; Here comes a list of regexes, separated by \\| - "Received signal [[:digit:]]+" - "\\).*") + (rx bol (* nonl) + (| "Permission denied" + "Login [Ii]ncorrect" + "Connection refused" + "Connection closed" + "Timeout, server not responding." + "Sorry, try again." + "Name or service not known" + "Host key verification failed." + "No supported authentication methods left to try!" + (: "Received signal " (+ digit))) + (* nonl)) "Regexp matching a `login failed' message. The regexp should match at end of buffer." :type 'regexp) (defcustom tramp-yesno-prompt-regexp - (concat - (regexp-opt - '("Are you sure you want to continue connecting (yes/no)?" - "Are you sure you want to continue connecting (yes/no/[fingerprint])?") - t) - "\\s-*") + (rx "Are you sure you want to continue connecting (yes/no" + (? "/[fingerprint]") ")?" + (* space)) "Regular expression matching all yes/no queries which need to be confirmed. The confirmation should be done with yes or no. The regexp should match at end of buffer. @@ -677,11 +673,9 @@ See also `tramp-yn-prompt-regexp'." :type 'regexp) (defcustom tramp-yn-prompt-regexp - (concat - (regexp-opt '("Store key in cache? (y/n)" - "Update cached key? (y/n, Return cancels connection)") - t) - "\\s-*") + (rx (| "Store key in cache? (y/n)" + "Update cached key? (y/n, Return cancels connection)") + (* space)) "Regular expression matching all y/n queries which need to be confirmed. The confirmation should be done with y or n. The regexp should match at end of buffer. @@ -698,11 +692,10 @@ files conditionalize this setup based on the TERM environment variable." :type 'string) (defcustom tramp-terminal-prompt-regexp - (concat "\\(" - "TERM = (.*)" - "\\|" - "Terminal type\\? \\[.*\\]" - "\\)\\s-*") + (rx (group + (| (: "TERM = (" (* nonl) ")") + (: "Terminal type? [" (* nonl) "]"))) + (* space)) "Regular expression matching all terminal setting prompts. The regexp should match at end of buffer. The answer will be provided by `tramp-action-terminal', which see." @@ -713,7 +706,7 @@ The answer will be provided by `tramp-action-terminal', which see." ;; "-no-antispoof". However, since we don't know which PuTTY ;; version is installed, we must react interactively. (defcustom tramp-antispoof-regexp - (regexp-quote "Access granted. Press Return to begin session. ") + (rx (literal "Access granted. Press Return to begin session. ")) "Regular expression matching plink's anti-spoofing message. The regexp should match at end of buffer." :version "27.1" @@ -723,42 +716,42 @@ The regexp should match at end of buffer." ;; with their finger. We must tell it to the user. ;; Added in OpenSSH 8.2. I've tested it with yubikey. (defcustom tramp-security-key-confirm-regexp - "^\r*Confirm user presence for key .*[\r\n]*" + (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) "Regular expression matching security key confirmation message. The regexp should match at end of buffer." :version "28.1" :type 'regexp) (defcustom tramp-security-key-confirmed-regexp - "^\r*User presence confirmed[\r\n]*" + (rx bol (* "\r") "User presence confirmed" (* (any "\r\n"))) "Regular expression matching security key confirmation message. The regexp should match at end of buffer." :version "28.1" :type 'regexp) (defcustom tramp-security-key-timeout-regexp - "^\r*sign_and_send_pubkey: signing failed for .*[\r\n]*" + (rx bol (* "\r") "sign_and_send_pubkey: signing failed for " + (* nonl) (* (any "\r\n"))) "Regular expression matching security key timeout message. The regexp should match at end of buffer." :version "28.1" :type 'regexp) (defcustom tramp-operation-not-permitted-regexp - (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*" - (regexp-opt '("Operation not permitted") t)) + (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* space) + "Operation not permitted") "Regular expression matching keep-date problems in (s)cp operations. Copying has been performed successfully already, so this message can be ignored safely." :type 'regexp) (defcustom tramp-copy-failed-regexp - (concat "\\(.+: " - (regexp-opt '("Permission denied" - "not a regular file" - "is a directory" - "No such file or directory") - t) - "\\)\\s-*") + (rx (+ nonl) ": " + (| "No such file or directory" + "Permission denied" + "is a directory" + "not a regular file") + (* space)) "Regular expression matching copy problems in (s)cp operations." :type 'regexp) @@ -809,6 +802,23 @@ Customize. See also `tramp-change-syntax'." :initialize #'custom-initialize-default :set #'tramp-set-syntax) +(defvar tramp-prefix-format) +(defvar tramp-prefix-regexp) +(defvar tramp-method-regexp) +(defvar tramp-postfix-method-format) +(defvar tramp-postfix-method-regexp) +(defvar tramp-prefix-ipv6-format) +(defvar tramp-prefix-ipv6-regexp) +(defvar tramp-postfix-ipv6-format) +(defvar tramp-postfix-ipv6-regexp) +(defvar tramp-postfix-host-format) +(defvar tramp-postfix-host-regexp) +(defvar tramp-remote-file-name-spec-regexp) +(defvar tramp-file-name-structure) +(defvar tramp-file-name-regexp) +(defvar tramp-completion-method-regexp) +(defvar tramp-completion-file-name-regexp) + (defun tramp-set-syntax (symbol value) "Set SYMBOL to value VALUE. Used in user option `tramp-syntax'. There are further variables @@ -822,24 +832,25 @@ to be set, depending on VALUE." ;; Set the value: (set-default symbol value) ;; Reset the depending variables. - (with-no-warnings - (setq tramp-prefix-format (tramp-build-prefix-format) - tramp-prefix-regexp (tramp-build-prefix-regexp) - tramp-method-regexp (tramp-build-method-regexp) - tramp-postfix-method-format (tramp-build-postfix-method-format) - tramp-postfix-method-regexp (tramp-build-postfix-method-regexp) - tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format) - tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp) - tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format) - tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp) - tramp-postfix-host-format (tramp-build-postfix-host-format) - tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) - tramp-remote-file-name-spec-regexp - (tramp-build-remote-file-name-spec-regexp) - tramp-file-name-structure (tramp-build-file-name-structure) - tramp-file-name-regexp (tramp-build-file-name-regexp) - tramp-completion-file-name-regexp - (tramp-build-completion-file-name-regexp))) + (setq tramp-prefix-format (tramp-build-prefix-format) + tramp-prefix-regexp (tramp-build-prefix-regexp) + tramp-method-regexp (tramp-build-method-regexp) + tramp-postfix-method-format (tramp-build-postfix-method-format) + tramp-postfix-method-regexp (tramp-build-postfix-method-regexp) + tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format) + tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp) + tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format) + tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp) + tramp-postfix-host-format (tramp-build-postfix-host-format) + tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) + tramp-remote-file-name-spec-regexp + (tramp-build-remote-file-name-spec-regexp) + tramp-file-name-structure (tramp-build-file-name-structure) + tramp-file-name-regexp (tramp-build-file-name-regexp) + tramp-completion-method-regexp + (tramp-build-completion-method-regexp) + tramp-completion-file-name-regexp + (tramp-build-completion-file-name-regexp)) ;; Rearrange file name handlers. (tramp-register-file-name-handlers)) @@ -872,30 +883,31 @@ Raise an error if it is invalid." "Return `tramp-prefix-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-prefix-format-alist)) -(defvar tramp-prefix-format nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-prefix-format nil ; Initialized when defining `tramp-syntax'! "String matching the very beginning of Tramp file names. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-regexp () "Return `tramp-prefix-regexp'." - (concat "^" (regexp-quote tramp-prefix-format))) + (rx bol (literal (tramp-build-prefix-format)))) -(defvar tramp-prefix-regexp nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-prefix-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching the very beginning of Tramp file names. Should always start with \"^\". Derived from `tramp-prefix-format'.") (defconst tramp-method-regexp-alist - '((default . "[[:alnum:]-]+") + `((default . ,(rx (| (literal tramp-default-method-marker) (>= 2 alnum)))) (simplified . "") - (separate . "[[:alnum:]-]*")) + (separate + . ,(rx (? (| (literal tramp-default-method-marker) (>= 2 alnum)))))) "Alist mapping Tramp syntax to regexps matching methods identifiers.") (defun tramp-build-method-regexp () "Return `tramp-method-regexp' according to `tramp-syntax'." (tramp-lookup-syntax tramp-method-regexp-alist)) -(defvar tramp-method-regexp nil ;Initialized when defining `tramp-syntax'! - "Regexp matching methods identifiers. +(defvar tramp-method-regexp nil ; Initialized when defining `tramp-syntax'! + "Regexp matching method identifiers. The `ftp' syntax does not support methods.") (defconst tramp-postfix-method-format-alist @@ -908,47 +920,47 @@ The `ftp' syntax does not support methods.") "Return `tramp-postfix-method-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-postfix-method-format-alist)) -(defvar tramp-postfix-method-format nil ;Init'd when defining `tramp-syntax'! +(defvar tramp-postfix-method-format nil ; Init'd when defining `tramp-syntax'! "String matching delimiter between method and user or host names. The `ftp' syntax does not support methods. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-method-regexp () "Return `tramp-postfix-method-regexp'." - (regexp-quote tramp-postfix-method-format)) + (rx (literal (tramp-build-postfix-method-format)))) -(defvar tramp-postfix-method-regexp nil ;Init'd when defining `tramp-syntax'! +(defvar tramp-postfix-method-regexp nil ; Init'd when defining `tramp-syntax'! "Regexp matching delimiter between method and user or host names. Derived from `tramp-postfix-method-format'.") -(defconst tramp-user-regexp "[^/|: \t]+" +(defconst tramp-user-regexp (rx (+ (not (any "/:|" space)))) "Regexp matching user names.") (defconst tramp-prefix-domain-format "%" "String matching delimiter between user and domain names.") -(defconst tramp-prefix-domain-regexp (regexp-quote tramp-prefix-domain-format) +(defconst tramp-prefix-domain-regexp (rx (literal tramp-prefix-domain-format)) "Regexp matching delimiter between user and domain names. Derived from `tramp-prefix-domain-format'.") -(defconst tramp-domain-regexp "[[:alnum:]_.-]+" +(defconst tramp-domain-regexp (rx (+ (any "._-" alnum))) "Regexp matching domain names.") (defconst tramp-user-with-domain-regexp - (concat "\\(" tramp-user-regexp "\\)" - tramp-prefix-domain-regexp - "\\(" tramp-domain-regexp "\\)") + (rx (group (regexp tramp-user-regexp)) + (regexp tramp-prefix-domain-regexp) + (group (regexp tramp-domain-regexp))) "Regexp matching user names with domain names.") (defconst tramp-postfix-user-format "@" "String matching delimiter between user and host names. Used in `tramp-make-tramp-file-name'.") -(defconst tramp-postfix-user-regexp (regexp-quote tramp-postfix-user-format) +(defconst tramp-postfix-user-regexp (rx (literal tramp-postfix-user-format)) "Regexp matching delimiter between user and host names. Derived from `tramp-postfix-user-format'.") -(defconst tramp-host-regexp "[[:alnum:]_.%-]+" +(defconst tramp-host-regexp (rx (+ (any "%._-" alnum))) "Regexp matching host names.") (defconst tramp-prefix-ipv6-format-alist @@ -961,22 +973,22 @@ Derived from `tramp-postfix-user-format'.") "Return `tramp-prefix-ipv6-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-prefix-ipv6-format-alist)) -(defvar tramp-prefix-ipv6-format nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-prefix-ipv6-format nil ; Initialized when defining `tramp-syntax'! "String matching left hand side of IPv6 addresses. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-ipv6-regexp () "Return `tramp-prefix-ipv6-regexp'." - (regexp-quote tramp-prefix-ipv6-format)) + (rx (literal tramp-prefix-ipv6-format))) -(defvar tramp-prefix-ipv6-regexp nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-prefix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching left hand side of IPv6 addresses. Derived from `tramp-prefix-ipv6-format'.") ;; The following regexp is a bit sloppy. But it shall serve our ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in ;; "::ffff:192.168.0.1". -(defconst tramp-ipv6-regexp "\\(?:[[:alnum:]]*:\\)+[[:alnum:].]+" +(defconst tramp-ipv6-regexp (rx (+ (* alnum) ":") (* (any "." alnum))) "Regexp matching IPv6 addresses.") (defconst tramp-postfix-ipv6-format-alist @@ -989,38 +1001,38 @@ Derived from `tramp-prefix-ipv6-format'.") "Return `tramp-postfix-ipv6-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-postfix-ipv6-format-alist)) -(defvar tramp-postfix-ipv6-format nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-postfix-ipv6-format nil ; Initialized when defining `tramp-syntax'! "String matching right hand side of IPv6 addresses. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-ipv6-regexp () "Return `tramp-postfix-ipv6-regexp'." - (regexp-quote tramp-postfix-ipv6-format)) + (rx (literal tramp-postfix-ipv6-format))) -(defvar tramp-postfix-ipv6-regexp nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-postfix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching right hand side of IPv6 addresses. Derived from `tramp-postfix-ipv6-format'.") (defconst tramp-prefix-port-format "#" "String matching delimiter between host names and port numbers.") -(defconst tramp-prefix-port-regexp (regexp-quote tramp-prefix-port-format) +(defconst tramp-prefix-port-regexp (rx (literal tramp-prefix-port-format)) "Regexp matching delimiter between host names and port numbers. Derived from `tramp-prefix-port-format'.") -(defconst tramp-port-regexp "[[:digit:]]+" +(defconst tramp-port-regexp (rx (+ digit)) "Regexp matching port numbers.") (defconst tramp-host-with-port-regexp - (concat "\\(" tramp-host-regexp "\\)" - tramp-prefix-port-regexp - "\\(" tramp-port-regexp "\\)") + (rx (group (regexp tramp-host-regexp)) + (regexp tramp-prefix-port-regexp) + (group (regexp tramp-port-regexp))) "Regexp matching host names with port numbers.") (defconst tramp-postfix-hop-format "|" "String matching delimiter after ad-hoc hop definitions.") -(defconst tramp-postfix-hop-regexp (regexp-quote tramp-postfix-hop-format) +(defconst tramp-postfix-hop-regexp (rx (literal tramp-postfix-hop-format)) "Regexp matching delimiter after ad-hoc hop definitions. Derived from `tramp-postfix-hop-format'.") @@ -1034,19 +1046,19 @@ Derived from `tramp-postfix-hop-format'.") "Return `tramp-postfix-host-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-postfix-host-format-alist)) -(defvar tramp-postfix-host-format nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-postfix-host-format nil ; Initialized when defining `tramp-syntax'! "String matching delimiter between host names and localnames. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-host-regexp () "Return `tramp-postfix-host-regexp'." - (regexp-quote tramp-postfix-host-format)) + (rx (literal tramp-postfix-host-format))) -(defvar tramp-postfix-host-regexp nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-postfix-host-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching delimiter between host names and localnames. Derived from `tramp-postfix-host-format'.") -(defconst tramp-localname-regexp "[^\n\r]*\\'" +(defconst tramp-localname-regexp (rx (* (not (any "\r\n"))) eos) "Regexp matching localnames.") (defconst tramp-unknown-id-string "UNKNOWN" @@ -1067,16 +1079,20 @@ Derived from `tramp-postfix-host-format'.") (defun tramp-build-remote-file-name-spec-regexp () "Construct a regexp matching a Tramp file name for a Tramp syntax. It is expected, that `tramp-syntax' has the proper value." - (concat - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" - "\\(" "\\(?:" tramp-host-regexp "\\|" - tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?" - tramp-postfix-ipv6-regexp "\\)" - "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")) + (rx ;; Method. + (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) + ;; Optional user. + (? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp)) + ;; Optional host. + (? (group (| (regexp tramp-host-regexp) + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp)) + (regexp tramp-postfix-ipv6-regexp))) + ;; Optional port. + (? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp)))))) (defvar tramp-remote-file-name-spec-regexp - nil ;Initialized when defining `tramp-syntax'! + nil ; Initialized when defining `tramp-syntax'! "Regular expression matching a Tramp file name between prefix and postfix.") (defun tramp-build-file-name-structure () @@ -1084,15 +1100,15 @@ It is expected, that `tramp-syntax' has the proper value." It is expected, that `tramp-syntax' has the proper value. See `tramp-file-name-structure'." (list - (concat - tramp-prefix-regexp - "\\(" "\\(?:" tramp-remote-file-name-spec-regexp - tramp-postfix-hop-regexp "\\)+" "\\)?" - tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp - "\\(" tramp-localname-regexp "\\)") + (rx (regexp tramp-prefix-regexp) + (? (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) + (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-host-regexp) + (group (regexp tramp-localname-regexp))) 5 6 7 8 1)) -(defvar tramp-file-name-structure nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-file-name-structure nil ; Initialized when defining `tramp-syntax'! "List detailing the Tramp file name structure. This is a list of six elements (REGEXP METHOD USER HOST FILE HOP). @@ -1117,7 +1133,8 @@ See also `tramp-file-name-regexp'.") (car tramp-file-name-structure)) ;;;###autoload -(defconst tramp-initial-file-name-regexp "\\`/[^/:]+:[^/:]*:" +(defconst tramp-initial-file-name-regexp + (rx bos "/" (+ (not (any "/:"))) ":" (* (not (any "/:"))) ":") "Value for `tramp-file-name-regexp' for autoload. It must match the initial `tramp-syntax' settings.") @@ -1134,78 +1151,56 @@ initial value is overwritten by the car of `tramp-file-name-structure'.") :version "27.1" :type '(choice (const nil) regexp)) -(defconst tramp-completion-file-name-regexp-default - (concat - "\\`" - ;; `file-name-completion' uses absolute paths for matching. This - ;; means that on W32 systems, something like "/ssh:host:~/path" - ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'. - (when (eq system-type 'windows-nt) - "\\(?:[[:alpha:]]:\\)?") - "/\\(" - ;; Optional multi hop. - "\\([^/|:]+:[^/|:]*|\\)*" - ;; Last hop. - (if (memq system-type '(cygwin windows-nt)) - ;; The method is either "-", or at least two characters. - "\\(-\\|[^/|:]\\{2,\\}\\)" - ;; At least one character for method. - "[^/|:]+") - ;; Method separator, user name and host name. - "\\(:[^/|:]*\\)?" - "\\)?\\'") - "Value for `tramp-completion-file-name-regexp' for default remoting. -See `tramp-file-name-structure' for more explanations. - -On W32 systems, the volume letter must be ignored.") - -(defconst tramp-completion-file-name-regexp-simplified - (concat - "\\`" - ;; Allow the volume letter at the beginning of the path. See the - ;; comment in `tramp-completion-file-name-regexp-default' for more - ;; details. - (when (eq system-type 'windows-nt) - "\\(?:[[:alpha:]]:\\)?") - "/\\(" - ;; Optional multi hop. - "\\([^/|:]*|\\)*" - ;; Last hop. - (if (memq system-type '(cygwin windows-nt)) - ;; At least two characters. - "[^/|:]\\{2,\\}" - ;; At least one character. - "[^/|:]+") - "\\)?\\'") - "Value for `tramp-completion-file-name-regexp' for simplified style remoting. -See `tramp-file-name-structure' for more explanations. - -On W32 systems, the volume letter must be ignored.") - -(defconst tramp-completion-file-name-regexp-separate - (concat - "\\`" - ;; Allow the volume letter at the beginning of the path. See the - ;; comment in `tramp-completion-file-name-regexp-default' for more - ;; details. - (when (eq system-type 'windows-nt) - "\\(?:[[:alpha:]]:\\)?") - "/\\(\\[[^]]*\\)?\\'") - "Value for `tramp-completion-file-name-regexp' for separate remoting. -See `tramp-file-name-structure' for more explanations.") - -(defconst tramp-completion-file-name-regexp-alist - `((default . ,tramp-completion-file-name-regexp-default) - (simplified . ,tramp-completion-file-name-regexp-simplified) - (separate . ,tramp-completion-file-name-regexp-separate)) - "Alist mapping incomplete Tramp file names.") +(defconst tramp-volume-letter-regexp + (if (eq system-type 'windows-nt) + (rx bos alpha ":") "") + "Volume letter on MS Windows.") + +;; `tramp-method-regexp' needs at least two characters, in order to +;; distinguish from volume letter. This is in the way when completing. +(defconst tramp-completion-method-regexp-alist + `((default . ,(rx (| (literal tramp-default-method-marker) (+ alnum)))) + (simplified . "") + (separate . ,(rx (| (literal tramp-default-method-marker) (* alnum))))) + "Alist mapping Tramp syntax to regexps matching completion methods.") + +(defun tramp-build-completion-method-regexp () + "Return `tramp-completion-method-regexp' according to `tramp-syntax'." + (tramp-lookup-syntax tramp-completion-method-regexp-alist)) + +(defvar tramp-completion-method-regexp + nil ; Initialized when defining `tramp-syntax'! + "Regexp matching completion method identifiers. +The `ftp' syntax does not support methods.") (defun tramp-build-completion-file-name-regexp () "Return `tramp-completion-file-name-regexp' according to `tramp-syntax'." - (tramp-lookup-syntax tramp-completion-file-name-regexp-alist)) + (if (eq tramp-syntax 'separate) + ;; FIXME: This shouldn't be necessary. + (rx bos "/" (? (group "[" (* (not (any "]"))))) eos) + (rx bos + ;; `file-name-completion' uses absolute paths for matching. + ;; This means that on W32 systems, something like + ;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also + ;; `tramp-drop-volume-letter'. + (? (regexp tramp-volume-letter-regexp)) + (regexp tramp-prefix-regexp) + + ;; Optional multi hops. + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + + ;; Last hop. + (? (regexp tramp-completion-method-regexp) + ;; Method separator, user name and host name. + (? (regexp tramp-postfix-method-regexp) + ;; This is a little bit lax, but it serves. + (? (regexp tramp-host-regexp)))) + + eos))) (defvar tramp-completion-file-name-regexp - nil ;Initialized when defining `tramp-syntax'! + nil ; Initialized when defining `tramp-syntax'! "Regular expression matching file names handled by Tramp completion. This regexp should match partial Tramp file names only. @@ -1218,14 +1213,8 @@ Also see `tramp-file-name-structure'.") ;;;###autoload (defconst tramp-autoload-file-name-regexp - (concat - "\\`/" - (if (memq system-type '(cygwin windows-nt)) - ;; The method is either "-", or at least two characters. - "\\(-\\|[^/|:]\\{2,\\}\\)" - ;; At least one character for method. - "[^/|:]+") - ":") + ;; The method is either "-", or at least two characters. + (rx bos "/" (| "-" (>= 2 (not (any "/:|")))) ":") "Regular expression matching file names handled by Tramp autoload. It must match the initial `tramp-syntax' settings. It should not match file names at root of the underlying local file system, @@ -1528,7 +1517,7 @@ If VEC is a vector, check first in connection properties. Afterwards, check in `tramp-methods'. If the `tramp-methods' entry does not exist, return nil." (let ((hash-entry - (replace-regexp-in-string "^tramp-" "" (symbol-name param)))) + (replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param)))) (if (tramp-connection-property-p vec hash-entry) ;; We use the cached property. (tramp-get-connection-property vec hash-entry) @@ -1548,10 +1537,7 @@ entry does not exist, return nil." "Return t if NAME is a string with Tramp file name syntax." (and tramp-mode (stringp name) ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'. - (not (string-match-p - (if (memq system-type '(cygwin windows-nt)) - "^/[[:alpha:]]?:" "^/:") - name)) + (not (string-match-p (rx bos "/" (? alpha) ":") name)) ;; Excluded file names. (or (null tramp-ignored-file-name-regexp) (not (string-match-p tramp-ignored-file-name-regexp name))) @@ -1744,7 +1730,7 @@ See `tramp-dissect-file-name' for details." (let ((v (tramp-dissect-file-name (concat tramp-prefix-format (replace-regexp-in-string - (concat tramp-postfix-hop-regexp "$") + (rx (regexp tramp-postfix-hop-regexp) eos) tramp-postfix-host-format name)) nodefault))) ;; Only some methods from tramp-sh.el do support multi-hops. @@ -1797,7 +1783,7 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." ;; Assure that the hops are in `tramp-default-proxies-alist'. ;; In tramp-archive.el, the slot `hop' is used for the archive ;; file name. - (unless (string-equal method "archive") + (unless (string-equal method tramp-archive-method) (tramp-add-hops (car args))))) (t (setq method (nth 0 args) @@ -1840,7 +1826,7 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." (replace-regexp-in-string tramp-prefix-regexp "" (replace-regexp-in-string - (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format + (rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format (tramp-make-tramp-file-name vec 'noloc))))) (defun tramp-completion-make-tramp-file-name (method user host localname) @@ -1955,10 +1941,12 @@ of `current-buffer'." (put #'tramp-debug-buffer-name 'tramp-suppress-trace t) (defconst tramp-debug-outline-regexp - (concat - "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp. - "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread. - "[[:alnum:]-]+ (\\([[:digit:]]+\\)) #") ;; Function name, verbosity. + (rx ;; Timestamp. + (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) " " + ;; Thread. + (? (group "#<thread " (+ nonl) ">") " ") + ;; Function name, verbosity. + (+ (any "-" alnum)) " (" (group (group (+ digit))) ") #") "Used for highlighting Tramp debug buffers in `outline-mode'.") (defconst tramp-debug-font-lock-keywords @@ -1967,7 +1955,7 @@ of `current-buffer'." ;; Also, in `font-lock-defaults' you can specify a function name for ;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords! '(list - (concat "^\\(?:" tramp-debug-outline-regexp "\\).+") + (rx bol (regexp tramp-debug-outline-regexp) (+ nonl)) '(1 font-lock-warning-face t t) '(0 (outline-font-lock-face) keep t)) "Used for highlighting Tramp debug buffers in `outline-mode'.") @@ -2421,13 +2409,16 @@ letter into the file name. This function removes it." (save-match-data (let ((quoted (tramp-compat-file-name-quoted-p name 'top)) (result (tramp-compat-file-name-unquote name 'top))) - (setq result (if (string-match "\\`[[:alpha:]]:/" result) - (replace-match "/" nil t result) result)) + (setq result + (if (string-match + (rx (regexp tramp-volume-letter-regexp) "/") result) + (replace-match "/" nil t result) result)) (if quoted (tramp-compat-file-name-quote result 'top) result)))) ;;; Config Manipulation Functions: -(defconst tramp-dns-sd-service-regexp "^_[-[:alnum:]]+\\._tcp$" +(defconst tramp-dns-sd-service-regexp + (rx bol "_" (+ (any "-" alnum)) "._tcp" eol) "DNS-SD service regexp.") ;;;###tramp-autoload @@ -2530,7 +2521,7 @@ coding system might not be determined. This function repairs it." ;; We found a matching entry in `file-coding-system-alist'. ;; So we add a similar entry, but with the temporary file name ;; as regexp. - (push (cons (regexp-quote tmpname) (cdr elt)) result))))) + (push (cons (rx (literal tmpname)) (cdr elt)) result))))) (defun tramp-run-real-handler (operation args) "Invoke normal file name handler for OPERATION. @@ -2808,14 +2799,12 @@ This avoids problems during autoload, when `load-path' contains remote file names." ;; We expect all other Tramp files in the same directory as tramp.el. (let* ((dir (expand-file-name (file-name-directory (locate-library "tramp")))) - (files-regexp - (format - "^%s$" - (regexp-opt - (mapcar - #'file-name-sans-extension - (directory-files dir nil "\\`tramp.+\\.elc?\\'")) - 'paren)))) + (files (delete-dups + (mapcar + #'file-name-sans-extension + (directory-files + dir nil (rx bos "tramp" (+ nonl) ".el" (? "c") eos))))) + (files-regexp (rx bol (: (regexp (regexp-opt files))) eol))) (mapatoms (lambda (atom) (when (and (functionp atom) @@ -2960,11 +2949,9 @@ not in completion mode." ;; Suppress hop from completion. (when (string-match - (concat - tramp-prefix-regexp - "\\(" "\\(" tramp-remote-file-name-spec-regexp - tramp-postfix-hop-regexp - "\\)+" "\\)") + (rx (regexp tramp-prefix-regexp) + (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) fullname) (setq hop (match-string 1 fullname) fullname (replace-match "" nil nil fullname 1))) @@ -3046,68 +3033,62 @@ not in completion mode." ;; ["x" nil "" nil] ["x" nil "y" nil] ["x" nil "y" ""] ;; ["x" "" nil nil] ["x" "y" nil nil] -;; "/x:y@""/[x/y@" "/x:y@z" "/[x/y@z" "/x:y@z:" "/[x/y@z]" -;;["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""] +;; "/x:y@" "/[x/y@" "/x:y@z" "/[x/y@z" "/x:y@z:" "/[x/y@z]" +;; ["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""] (defun tramp-completion-dissect-file-name (name) "Return a list of `tramp-file-name' structures for NAME. They are collected by `tramp-completion-dissect-file-name1'." - (let* ((x-nil "\\|\\(\\)") - (tramp-completion-ipv6-regexp - (format - "[^%s]*" - (if (zerop (length tramp-postfix-ipv6-format)) - tramp-postfix-host-format - tramp-postfix-ipv6-format))) - ;; "/method" "/[method" + (let* (;; "/method" "/[method" (tramp-completion-file-name-structure1 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (? (regexp tramp-completion-method-regexp))) eol) 1 nil nil nil)) ;; "/method:user" "/[method/user" (tramp-completion-file-name-structure2 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(" tramp-user-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (? (regexp tramp-user-regexp))) eol) 1 2 nil nil)) ;; "/method:host" "/[method/host" (tramp-completion-file-name-structure3 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(" tramp-host-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (? (regexp tramp-host-regexp))) eol) 1 nil 2 nil)) ;; "/method:[ipv6" "/[method/ipv6" (tramp-completion-file-name-structure4 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - tramp-prefix-ipv6-regexp - "\\(" tramp-completion-ipv6-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (? (regexp tramp-ipv6-regexp))) eol) 1 nil 2 nil)) ;; "/method:user@host" "/[method/user@host" (tramp-completion-file-name-structure5 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp - "\\(" tramp-host-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (group (? (regexp tramp-host-regexp))) eol) 1 2 3 nil)) ;; "/method:user@[ipv6" "/[method/user@ipv6" (tramp-completion-file-name-structure6 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp - tramp-prefix-ipv6-regexp - "\\(" tramp-completion-ipv6-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (? (regexp tramp-ipv6-regexp))) eol) 1 2 3 nil))) (delq nil @@ -3203,7 +3184,7 @@ for all methods. Resulting data are derived from default settings." "Return a (user host) tuple allowed to access. User is always nil." (let (result) - (when (re-search-forward regexp (point-at-eol) t) + (when (re-search-forward regexp (line-end-position) t) (setq result (list nil (match-string match-level)))) (or (> (skip-chars-forward skip-chars) 0) @@ -3233,11 +3214,10 @@ Either user or host may be nil." Either user or host may be nil." (let (result (regexp - (concat - "^\\(" tramp-host-regexp "\\)" - "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) - (when (re-search-forward regexp (point-at-eol) t) - (setq result (append (list (match-string 3) (match-string 1))))) + (rx bol (group (regexp tramp-host-regexp)) + (? (+ space) (group (regexp tramp-user-regexp)))))) + (when (re-search-forward regexp (line-end-position) t) + (setq result (append (list (match-string 2) (match-string 1))))) (forward-line 1) result)) @@ -3249,7 +3229,7 @@ User is always nil." (defun tramp-parse-shosts-group () "Return a (user host) tuple allowed to access. User is always nil." - (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ",")) + (tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ",")) (defun tramp-parse-sconfig (filename) "Return a list of (user host) tuples allowed to access. @@ -3260,9 +3240,10 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (concat "\\(?:^[ \t]*Host\\)" "\\|" "\\(?:^.+\\)" - "\\|" "\\(" tramp-host-regexp "\\)") - 1 " \t")) + (rx (| (: bol (* space) "Host") + (: bol (+ nonl)) ;; ??? + (group (regexp tramp-host-regexp)))) + 1 (rx space))) ;; Generic function. (defun tramp-parse-shostkeys-sknownhosts (dirname regexp) @@ -3274,21 +3255,24 @@ User is always nil." (files (and (file-directory-p dirname) (directory-files dirname)))) (cl-loop for f in files - when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f)) + when (and (not (string-match-p (rx bol (** 1 2 ".") eol) f)) + (string-match regexp f)) collect (list nil (match-string 1 f))))) (defun tramp-parse-shostkeys (dirname) "Return a list of (user host) tuples allowed to access. User is always nil." (tramp-parse-shostkeys-sknownhosts - dirname (concat "^key_[[:digit:]]+_\\(" tramp-host-regexp "\\)\\.pub$"))) + dirname + (rx bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol))) (defun tramp-parse-sknownhosts (dirname) "Return a list of (user host) tuples allowed to access. User is always nil." (tramp-parse-shostkeys-sknownhosts dirname - (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))) + (rx bol (group (regexp tramp-host-regexp)) + ".ssh-" (| "dss" "rsa") ".pub" eol))) (defun tramp-parse-hosts (filename) "Return a list of (user host) tuples allowed to access. @@ -3299,7 +3283,8 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t")) + (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) + 1 (rx space))) (defun tramp-parse-passwd (filename) "Return a list of (user host) tuples allowed to access. @@ -3317,8 +3302,8 @@ Host is always \"localhost\"." "Return a (user host) tuple allowed to access. Host is always \"localhost\"." (let (result - (regexp (concat "^\\(" tramp-user-regexp "\\):"))) - (when (re-search-forward regexp (point-at-eol) t) + (regexp (rx bol (group (regexp tramp-user-regexp)) ":"))) + (when (re-search-forward regexp (line-end-position) t) (setq result (list (match-string 1) "localhost"))) (forward-line 1) result)) @@ -3339,7 +3324,8 @@ Host is always \"localhost\"." "Return a (group host) tuple allowed to access. Host is always \"localhost\"." (let (result - (split (split-string (buffer-substring (point) (point-at-eol)) ":"))) + (split + (split-string (buffer-substring (point) (line-end-position)) ":"))) (when (member (user-login-name) (split-string (nth 3 split) "," 'omit)) (setq result (list (nth 0 split) "localhost"))) (forward-line 1) @@ -3367,14 +3353,14 @@ User is always nil." (tramp-parse-putty-group registry-or-dirname))))) ;; UNIX case. (tramp-parse-shostkeys-sknownhosts - registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$")))) + registry-or-dirname (rx bol (group (regexp tramp-host-regexp)) eol)))) (defun tramp-parse-putty-group (registry) "Return a (user host) tuple allowed to access. User is always nil." (let (result - (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)"))) - (when (re-search-forward regexp (point-at-eol) t) + (regexp (rx (literal registry) "\\" (group (+ nonl))))) + (when (re-search-forward regexp (line-end-position) t) (setq result (list nil (match-string 1)))) (forward-line 1) result)) @@ -3773,7 +3759,9 @@ Let-bind it when necessary.") ;; Expand tilde. Usually, the methods applying this handler do ;; not support tilde expansion. But users could declare a ;; respective connection property. (Bug#53847) - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -3783,10 +3771,10 @@ Let-bind it when necessary.") (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) - (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) + (string-prefix-p "~" localname)) (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "/./" and "/../"). ;; `default-directory' is bound, because on Windows there would @@ -3794,7 +3782,7 @@ Let-bind it when necessary.") (let ((default-directory tramp-compat-temporary-file-directory)) (tramp-make-tramp-file-name v (tramp-drop-volume-letter - (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (if (string-prefix-p "~" localname) localname (tramp-run-real-handler #'expand-file-name (list localname))))))))) @@ -3805,7 +3793,10 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." - (eq (file-attribute-type (file-attributes (file-truename filename))) t)) + ;; `file-truename' could raise an error, for example due to a cyclic + ;; symlink. + (ignore-errors + (eq (file-attribute-type (file-attributes (file-truename filename))) t))) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equalp-p' for Tramp files." @@ -3890,7 +3881,7 @@ Let-bind it when necessary.") ;; lower case letters. This avoids us to create a ;; temporary file. (while (and (string-match-p - "[[:lower:]]" (tramp-file-local-name candidate)) + (rx lower) (tramp-file-local-name candidate)) (not (file-exists-p candidate))) (setq candidate (directory-file-name @@ -3898,7 +3889,7 @@ Let-bind it when necessary.") ;; Nothing found, so we must use a temporary file ;; for comparison. (unless (string-match-p - "[[:lower:]]" (tramp-file-local-name candidate)) + (rx lower) (tramp-file-local-name candidate)) (setq tmpfile (let ((default-directory (file-name-directory filename))) @@ -3933,7 +3924,8 @@ Let-bind it when necessary.") (and completion-ignored-extensions (string-match-p - (concat (regexp-opt completion-ignored-extensions 'paren) "$") x) + (rx (regexp (regexp-opt completion-ignored-extensions)) eos) + x) ;; We remember the hit. (push x hits-ignored-extensions)))))) ;; No match. So we try again for ignored files. @@ -3975,7 +3967,8 @@ Let-bind it when necessary.") ;; links. (when-let ((symlink (file-symlink-p filename))) (and (stringp symlink) - (file-readable-p (concat (file-remote-p filename) symlink)))))))) + (file-readable-p + (concat (file-remote-p filename) symlink)))))))) (defun tramp-handle-file-regular-p (filename) "Like `file-regular-p' for Tramp files." @@ -4111,9 +4104,10 @@ Let-bind it when necessary.") (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p - (concat - "Backup file on local temporary directory, " - "do you want to continue?"))))) + (eval-when-compile + (concat + "Backup file on local temporary directory, " + "do you want to continue?")))))) (tramp-error v 'file-error "Unsafe backup file name")))))) (defun tramp-handle-insert-directory @@ -4142,12 +4136,13 @@ Let-bind it when necessary.") (goto-char (point-min)) (while (setq start (text-property-not-all - (point) (point-at-eol) 'dired-filename t)) + (point) (line-end-position) 'dired-filename t)) (delete-region start - (or (text-property-any start (point-at-eol) 'dired-filename t) - (point-at-eol))) - (if (= (point-at-bol) (point-at-eol)) + (or (text-property-any + start (line-end-position) 'dired-filename t) + (line-end-position))) + (if (= (line-beginning-position) (line-end-position)) ;; Empty line. (delete-region (point) (progn (forward-line) (point))) (forward-line))))))))) @@ -4269,15 +4264,13 @@ Let-bind it when necessary.") (defun tramp-ps-time () "Read printed time oif \"ps\" in format \"[[DD-]hh:]mm:ss\". Return it as number of seconds. Used in `tramp-process-attributes-ps-format'." - (search-forward-regexp "\\s-+") - (search-forward-regexp - (concat - "\\(?:" "\\(?:" "\\([0-9]+\\)-" "\\)?" - "\\([0-9]+\\):" "\\)?" - "\\([0-9]+\\):" - ;; Seconds can also be a floating point number. - "\\([0-9.]+\\)") - (line-end-position) 'noerror) + (search-forward-regexp (rx (+ space))) + (search-forward-regexp (rx (? (? (group (+ digit)) "-") + (group (+ digit)) ":") + (group (+ digit)) ":" + ;; Seconds can also be a floating point num. + (group (+ (any "." digit)))) + (line-end-position) 'noerror) (+ (* 24 60 60 (string-to-number (or (match-string 1) "0"))) (* 60 60 (string-to-number (or (match-string 2) "0"))) (* 60 (string-to-number (or (match-string 3) "0"))) @@ -4382,7 +4375,7 @@ It is not guaranteed, that all process attributes as described in ;; "%s" (buffer-substring (point) (line-end-position))) (when (save-excursion (search-forward-regexp - "[[:digit:]]" (line-end-position) 'noerror)) + (rx digit) (line-end-position) 'noerror)) (setq res nil) (dolist (elt tramp-process-attributes-ps-format) (push @@ -4391,16 +4384,17 @@ It is not guaranteed, that all process attributes as described in (cond ((eq (cdr elt) 'number) (read (current-buffer))) ((eq (cdr elt) 'string) - (search-forward-regexp "\\S-+") + (search-forward-regexp (rx (+ (not space)))) (match-string 0)) ((numberp (cdr elt)) - (search-forward-regexp "\\s-+") - (search-forward-regexp ".+" (+ (point) (cdr elt))) + (search-forward-regexp (rx (+ space))) + (search-forward-regexp + (rx (+ nonl)) (+ (point) (cdr elt))) (string-trim (match-string 0))) ((fboundp (cdr elt)) (funcall (cdr elt))) ((null (cdr elt)) - (search-forward-regexp "\\s-+") + (search-forward-regexp (rx (+ whitespace))) (buffer-substring (point) (line-end-position))))) res)) ;; `nice' could be `-'. @@ -4442,7 +4436,10 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defconst tramp-lock-file-info-regexp ;; USER@HOST.PID[:BOOT_TIME] - "\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'" + (rx bos (group (+ nonl)) + "@" (group (+ nonl)) + "." (group (+ digit)) + (? ":" (group (+ digit))) eos) "The format of a lock file.") (defun tramp-handle-file-locked-p (file) @@ -4497,9 +4494,10 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p - (concat - "Lock file on local temporary directory, " - "do you want to continue?"))))) + (eval-when-compile + (concat + "Lock file on local temporary directory, " + "do you want to continue?")))))) (tramp-error v 'file-error "Unsafe lock file name"))) ;; Do the lock. @@ -4538,7 +4536,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") ;; The first condition is always true for absolute file names. ;; Included for safety's sake. (unless (or (file-name-directory file) - (string-match-p "\\.elc?\\'" file)) + (string-match-p (rx ".el" (? "c") eos) file)) (tramp-error v 'file-error "File `%s' does not include a `.el' or `.elc' suffix" file))) @@ -4571,9 +4569,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") tramp-prefix-format proxy tramp-postfix-host-format)) (entry (list (and (stringp host-port) - (concat "^" (regexp-quote host-port) "$")) + (rx bol (literal host-port) eol)) (and (stringp user-domain) - (concat "^" (regexp-quote user-domain) "$")) + (rx bol (literal user-domain) eol)) (propertize proxy 'tramp-ad-hoc t)))) (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry) ;; Add the hop. @@ -4652,7 +4650,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (setq tramp-default-proxies-alist saved-tdpa) (tramp-user-error vec "Host name `%s' does not match `%s'" host previous-host)) - (setq previous-host (concat "^" (regexp-quote host) "$"))))) + (setq previous-host (rx bol (literal host) eol))))) ;; Result. target-alist)) @@ -4841,7 +4839,7 @@ support symbolic links." (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." - (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) + (let* ((asynchronous (string-match-p (rx (* space) "&" (* space) eos) command)) (command (substring command 0 asynchronous)) current-buffer-p (output-buffer-p output-buffer) @@ -5024,14 +5022,14 @@ BUFFER might be a list, in this case STDERR is separated." (let (process-environment) ;; Ignore in LOCALNAME everything before "//" or "/~". (when (stringp localname) - (if (string-match "//\\(/\\|~\\)" localname) + (if (string-match-p (rx "//" (| "/" "~")) localname) (setq filename (replace-regexp-in-string - "\\`/+" "/" (substitute-in-file-name localname))) + (rx bos (+ "/")) "/" (substitute-in-file-name localname))) (setq filename (concat (file-remote-p filename) (replace-regexp-in-string - "\\`/+" "/" + (rx bos (+ "/")) "/" ;; We must disable cygwin-mount file name ;; handlers and alike. (tramp-run-real-handler @@ -5278,7 +5276,8 @@ Wait, until the connection buffer changes." (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string 0)) + (with-temp-message + (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0)) ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. @@ -5614,7 +5613,7 @@ the remote host use line-endings as defined in the variable (tramp-flush-directory-properties vec "/")) (when (buffer-live-p buf) (with-current-buffer buf - (when (and prompt (tramp-search-regexp (regexp-quote prompt))) + (when (and prompt (tramp-search-regexp (rx (literal prompt)))) (delete-region (point) (point-max)))))))) (defun tramp-get-inode (vec) @@ -5818,7 +5817,7 @@ VEC is used for tracing." (while candidates (goto-char (point-min)) (if (string-match-p - (format "^%s\r?$" (regexp-quote (car candidates))) + (rx bol (literal (car candidates)) (? "\r") eol) (buffer-string)) (setq locale (car candidates) candidates nil) @@ -5926,7 +5925,9 @@ to cache the result. Return the modified ATTR." (when (consp (car attr)) (setcar attr (and (stringp (caar attr)) - (string-match ".+ -> .\\(.+\\)." (caar attr)) + (string-match + (rx (+ nonl) " -> " nonl (group (+ nonl)) nonl) + (caar attr)) (decode-coding-string (match-string 1 (caar attr)) 'utf-8)))) ;; Set file's gid change bit. @@ -6111,9 +6112,10 @@ this file, if that variable is non-nil." (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p - (concat - "Autosave file on local temporary directory, " - "do you want to continue?"))))) + (eval-when-compile + (concat + "Autosave file on local temporary directory, " + "do you want to continue?")))))) (tramp-error v 'file-error "Unsafe autosave file name")))))) (defun tramp-subst-strs-in-string (alist string) @@ -6124,7 +6126,7 @@ ALIST is of the form ((FROM . TO) ...)." (let* ((pr (car alist)) (from (car pr)) (to (cdr pr))) - (while (string-match (regexp-quote from) string) + (while (string-match (rx (literal from)) string) (setq string (replace-match to t t string))) (setq alist (cdr alist)))) string)) @@ -6226,7 +6228,7 @@ verbosity of 6." (apply #'process-lines program args) (error (tramp-error vec (car err) (cdr err))))) - (tramp-message vec 6 "%s" result) + (tramp-message vec 6 "\n%s" (mapconcat #'identity result "\n")) result)) (defun tramp-process-running-p (process-name) diff --git a/lisp/obsolete/autoload.el b/lisp/obsolete/autoload.el index a30f8271a3b..680df739e0b 100644 --- a/lisp/obsolete/autoload.el +++ b/lisp/obsolete/autoload.el @@ -713,7 +713,7 @@ autoload definitions. When called from Lisp, use the existing value of `generated-autoload-file'. If any Lisp file binds `generated-autoload-file' as a file-local variable, write its autoloads into the specified file instead." - (declare (obsolete make-directory-autoloads "28.1")) + (declare (obsolete loaddefs-generate "29.1")) (interactive "DUpdate autoloads from directory: ") (make-directory-autoloads dirs diff --git a/lisp/obsolete/netrc.el b/lisp/obsolete/netrc.el index f664a77a9b1..0114dadbabf 100644 --- a/lisp/obsolete/netrc.el +++ b/lisp/obsolete/netrc.el @@ -82,7 +82,7 @@ (goto-char (point-min)) ;; Go through the file, line by line. (while (not (eobp)) - (narrow-to-region (point) (point-at-eol)) + (narrow-to-region (point) (line-end-position)) ;; For each line, get the tokens and values. (while (not (eobp)) (skip-chars-forward "\t ") @@ -205,7 +205,7 @@ MODE can be \"login\" or \"password\", suitable for passing to (with-temp-buffer (insert-file-contents netrc-services-file) (while (search-forward "#" nil t) - (delete-region (1- (point)) (point-at-eol))) + (delete-region (1- (point)) (line-end-position))) (goto-char (point-min)) (while (re-search-forward "^ *\\([^ \n\t]+\\)[ \t]+\\([0-9]+\\)/\\([^ \t\n]+\\)" nil t) diff --git a/lisp/obsolete/tpu-extras.el b/lisp/obsolete/tpu-extras.el index 76338cdd24e..d631c47705d 100644 --- a/lisp/obsolete/tpu-extras.el +++ b/lisp/obsolete/tpu-extras.el @@ -292,7 +292,7 @@ Prefix argument serves as repeat count." (bottom (save-excursion (move-to-window-line bottom-margin) (point))) (far (save-excursion (goto-char bottom) - (point-at-bol (1- height))))) + (line-beginning-position (1- height))))) ,@body)) (defun tpu-paragraph (num) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 3b114703cdc..41b7a2a9713 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -917,7 +917,7 @@ arguments and pop open the results in a preview buffer." vals "")))))) (save-excursion (goto-char begin) - (goto-char (point-at-eol)) + (goto-char (line-end-position)) (unless (= (char-before (point)) ?\ ) (insert " ")) (insert ":" header-arg) (when value (insert " " value))))) @@ -1936,9 +1936,9 @@ region is not active then the point is demarcated." (let ((lang (nth 0 info)) (indent (make-string (current-indentation) ?\s))) (when (string-match "^[[:space:]]*$" - (buffer-substring (point-at-bol) - (point-at-eol))) - (delete-region (point-at-bol) (point-at-eol))) + (buffer-substring (line-beginning-position) + (line-end-position))) + (delete-region (line-beginning-position) (line-end-position))) (insert (concat (if (looking-at "^") "" "\n") indent (if upper-case-p "#+END_SRC\n" "#+end_src\n") diff --git a/lisp/org/ob-julia.el b/lisp/org/ob-julia.el index 50a44bcf448..de69f25fc30 100644 --- a/lisp/org/ob-julia.el +++ b/lisp/org/ob-julia.el @@ -26,6 +26,9 @@ ;; Org-Babel support for evaluating julia code ;; ;; Based on ob-R.el by Eric Schulte and Dan Davison. +;; +;; Session support requires the installation of the DataFrames and CSV +;; Julia packages. ;;; Code: (require 'cl-lib) @@ -62,6 +65,7 @@ (defvar ess-current-process-name) ; dynamically scoped (defvar ess-local-process-name) ; dynamically scoped (defvar ess-eval-visibly-p) ; dynamically scoped +(defvar ess-local-customize-alist); dynamically scoped (defun org-babel-edit-prep:julia (info) (let ((session (cdr (assq :session (nth 2 info))))) (when (and session @@ -281,7 +285,8 @@ last statement in BODY, as elisp." (value (with-temp-buffer (insert (org-babel-chomp body)) - (let ((ess-local-process-name + (let ((ess-local-customize-alist t) + (ess-local-process-name (process-name (get-buffer-process session))) (ess-eval-visibly-p nil)) (ess-eval-buffer nil))) diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el index dd204d7f6b1..f1ea803ba31 100644 --- a/lisp/org/ob-lilypond.el +++ b/lisp/org/ob-lilypond.el @@ -312,7 +312,7 @@ LINENO is the number of the erroneous line." (progn (goto-char (point-min)) (forward-line (- lineNo 1)) - (buffer-substring (point) (point-at-eol))) + (buffer-substring (point) (line-end-position))) nil))) (defun org-babel-lilypond-attempt-to-open-pdf (file-name &optional test) diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index bbbda5bb1e5..9be8f5ad3eb 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -255,7 +255,7 @@ This removes initial blank and comment lines and then calls (insert-file-contents file-name) (re-search-forward "^[ \t]*[^# \t]" nil t) (when (< (setq beg (point-min)) - (setq end (point-at-bol))) + (setq end (line-beginning-position))) (delete-region beg end))) (org-babel-import-elisp-from-file temp-file '(16)))) diff --git a/lisp/org/oc-basic.el b/lisp/org/oc-basic.el index 8c76e200e4f..398d2e2d3fa 100644 --- a/lisp/org/oc-basic.el +++ b/lisp/org/oc-basic.el @@ -460,12 +460,13 @@ substitutes for the unknown key. Finally, it may be the symbol (_ (lambda () (interactive) - (setf (buffer-substring beg end) - (concat "@" - (if (= 1 (length suggestions)) - (car suggestions) - (completing-read "Did you mean: " - suggestions nil t)))))))) + (goto-char beg) + (delete-region beg end) + (insert "@" + (if (= 1 (length suggestions)) + (car suggestions) + (completing-read "Did you mean: " + suggestions nil t))))))) (put-text-property beg end 'keymap km))) (defun org-cite-basic-activate (citation) diff --git a/lisp/org/ol-irc.el b/lisp/org/ol-irc.el index ed8bad5a50a..e36c44ff704 100644 --- a/lisp/org/ol-irc.el +++ b/lisp/org/ol-irc.el @@ -135,13 +135,13 @@ result is a cons of the filename and search string." ;; can we get a '::' part? (if (string= erc-line (erc-prompt)) (progn - (goto-char (point-at-bol)) + (goto-char (line-beginning-position)) (when (search-backward-regexp "^[^ ]" nil t) - (buffer-substring-no-properties (point-at-bol) - (point-at-eol)))) + (buffer-substring-no-properties (line-beginning-position) + (line-end-position)))) (when (search-backward erc-line nil t) - (buffer-substring-no-properties (point-at-bol) - (point-at-eol))))))) + (buffer-substring-no-properties (line-beginning-position) + (line-end-position))))))) (defun org-irc-erc-store-link () "Store a link to the IRC log file or the session itself. @@ -151,7 +151,7 @@ the session itself." (require 'erc-log) (if org-irc-link-to-logs (let* ((erc-line (buffer-substring-no-properties - (point-at-bol) (point-at-eol))) + (line-beginning-position) (line-end-position))) (parsed-line (org-irc-erc-get-line-from-log erc-line))) (if (erc-logging-enabled nil) (progn diff --git a/lisp/org/ol.el b/lisp/org/ol.el index a9e613e0d4e..4ad1f6d3452 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -1481,7 +1481,7 @@ non-nil." (let ((end (region-end))) (goto-char (region-beginning)) (set-mark (point)) - (while (< (point-at-eol) end) + (while (< (line-end-position) end) (move-end-of-line 1) (activate-mark) (let (current-prefix-arg) (call-interactively 'org-store-link)) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index a43b083d536..35f19cf03b4 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -2113,7 +2113,7 @@ in that string. If STRING is nil, it will be fetched from the beginning of the current line." (declare (debug t)) (org-with-gensyms (marker) - `(let ((,marker (get-text-property (if ,string 0 (point-at-bol)) + `(let ((,marker (get-text-property (if ,string 0 (line-beginning-position)) 'org-hd-marker ,string))) (with-current-buffer (marker-buffer ,marker) (save-excursion @@ -3076,10 +3076,10 @@ s Search for keywords M Like m, but only TODO entries (when (eq rmheader t) (org-goto-line 1) (re-search-forward ":" nil t) - (delete-region (match-end 0) (point-at-eol)) + (delete-region (match-end 0) (line-end-position)) (forward-char 1) (looking-at "-+") - (delete-region (match-end 0) (point-at-eol)) + (delete-region (match-end 0) (line-end-position)) (move-marker header-end (match-end 0))) (goto-char header-end) (delete-region (point) (point-max)) @@ -3505,10 +3505,10 @@ This ensures the export commands can easily use it." "Mark the line at POS as an agenda structure header." (save-excursion (goto-char pos) - (put-text-property (point-at-bol) (point-at-eol) + (put-text-property (line-beginning-position) (line-end-position) 'org-agenda-structural-header t) (when org-agenda-title-append - (put-text-property (point-at-bol) (point-at-eol) + (put-text-property (line-beginning-position) (line-end-position) 'org-agenda-title-append org-agenda-title-append)))) (defvar org-mobile-creating-agendas) ; defined in org-mobile.el @@ -3715,7 +3715,7 @@ removed from the entry content. Currently only `planning' is allowed here." (while (not (eobp)) (unless (looking-at "[ \t]*$") (move-to-column ind) - (delete-region (point-at-bol) (point))) + (delete-region (line-beginning-position) (point))) (beginning-of-line 2)) (run-hooks 'org-agenda-entry-text-cleanup-hook) @@ -3987,7 +3987,7 @@ agenda display, configure `org-agenda-finalize-hook'." (goto-char (point-min)) (while (equal (forward-line) 0) (when (setq mrk (get-text-property (point) 'org-hd-marker)) - (put-text-property (point-at-bol) (point-at-eol) + (put-text-property (line-beginning-position) (line-end-position) 'tags (org-with-point-at mrk (org-get-tags)))))))) @@ -4035,7 +4035,8 @@ agenda display, configure `org-agenda-finalize-hook'." (goto-char s) (when (equal (org-get-at-bol 'org-hd-marker) org-clock-hd-marker) - (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol)))) + (setq ov (make-overlay (line-beginning-position) + (1+ (line-end-position)))) (overlay-put ov 'type 'org-agenda-clocking) (overlay-put ov 'face 'org-agenda-clocking) (overlay-put ov 'help-echo @@ -4066,7 +4067,7 @@ agenda display, configure `org-agenda-finalize-hook'." b (match-beginning 1) e (if (eq org-agenda-fontify-priorities 'cookies) (1+ (match-end 2)) - (point-at-eol)) + (line-end-position)) ov (make-overlay b e)) (overlay-put ov 'face @@ -4168,7 +4169,7 @@ A good way to set it is through options in `org-agenda-custom-commands'.") "Throw to `:skip' in places that should be skipped. Also moves point to the end of the skipped region, so that search can continue from there." - (let ((p (point-at-bol)) to) + (let ((p (line-beginning-position)) to) (when (or (save-excursion (goto-char p) (looking-at comment-start-skip)) (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) @@ -4244,7 +4245,7 @@ This check for agenda markers in all agenda buffers currently active." m org-agenda-entry-text-maxlines org-agenda-entry-text-leaders)))) (when (string-match "\\S-" txt) - (setq o (make-overlay (point-at-bol) (point-at-eol))) + (setq o (make-overlay (line-beginning-position) (line-end-position))) (overlay-put o 'evaporate t) (overlay-put o 'org-overlay-type 'agenda-entry-content) (overlay-put o 'after-string txt)))) @@ -4749,7 +4750,7 @@ is active." (forward-line -1) (org-back-to-heading t))) (skip-chars-forward "* ") - (setq beg (point-at-bol) + (setq beg (line-beginning-position) beg1 (point) end (progn (outline-next-heading) @@ -4764,8 +4765,8 @@ is active." (goto-char beg) (org-agenda-skip) (setq str (buffer-substring-no-properties - (point-at-bol) - (if hdl-only (point-at-eol) end))) + (line-beginning-position) + (if hdl-only (line-end-position) end))) (mapc (lambda (wr) (when (string-match wr str) (goto-char (1- end)) (throw :skip t))) @@ -4793,7 +4794,7 @@ is active." txt (org-agenda-format-item "" (buffer-substring-no-properties - beg1 (point-at-eol)) + beg1 (line-end-position)) level category tags t)) (org-add-props txt props 'org-marker marker 'org-hd-marker marker @@ -5335,7 +5336,7 @@ each date. It also removes lines that contain only whitespace." (abbreviate-file-name buffer-file-name)) "") 'org-agenda-diary-link t - 'org-marker (org-agenda-new-marker (point-at-bol)))) + 'org-marker (org-agenda-new-marker (line-beginning-position)))) (defun org-diary-default-entry () "Add a dummy entry to the diary. @@ -5986,7 +5987,7 @@ then those holidays will be skipped." clockp (not (or closedp statep)) state (and statep (match-string 2)) category (org-get-category (match-beginning 0)) - timestr (buffer-substring (match-beginning 0) (point-at-eol))) + timestr (buffer-substring (match-beginning 0) (line-end-position))) (when (string-match "\\]" timestr) ;; substring should only run to end of time stamp (setq rest (substring timestr (match-end 0)) @@ -6044,7 +6045,7 @@ then those holidays will be skipped." 'type type 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) (push txt ee)) - (goto-char (point-at-eol)))) + (goto-char (line-end-position)))) (nreverse ee))) (defun org-agenda-show-clocking-issues () @@ -6081,7 +6082,7 @@ See also the user option `org-agenda-clock-consistency-checks'." (setq issue "No valid clock line") (throw 'next t)) (org-with-point-at m (save-excursion - (goto-char (point-at-bol)) + (goto-char (line-beginning-position)) (unless (looking-at re) (error "No valid Clock line") (throw 'next t)) @@ -6127,7 +6128,7 @@ See also the user option `org-agenda-clock-consistency-checks'." (setq tlend (or te tlend) tlstart (or ts tlstart)) (when issue ;; OK, there was some issue, add an overlay to show the issue - (setq ov (make-overlay (point-at-bol) (point-at-eol))) + (setq ov (make-overlay (line-beginning-position) (line-end-position))) (overlay-put ov 'before-string (concat (org-add-props @@ -7147,7 +7148,10 @@ The optional argument TYPE tells the agenda type." (save-excursion (beginning-of-line 1) (setq re (org-get-at-bol 'org-todo-regexp)) - (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point))) + (goto-char (or (text-property-any (line-beginning-position) + (line-end-position) + 'org-heading t) + (point))) (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) (add-text-properties (match-beginning 0) (match-end 1) (list 'face (org-get-todo-face 1))) @@ -7428,7 +7432,7 @@ subtree." (point) (if org-agenda-restriction-lock-highlight-subtree (save-excursion (org-end-of-subtree t t) (point)) - (point-at-eol))) + (line-end-position))) (move-marker org-agenda-restrict-begin (point)) (move-marker org-agenda-restrict-end (save-excursion (org-end-of-subtree t t))) @@ -8254,8 +8258,8 @@ grouptags." (defun org-agenda-filter-hide-line (type) "If current line is TYPE, hide it in the agenda buffer." (let* (buffer-invisibility-spec - (beg (max (point-min) (1- (point-at-bol)))) - (end (point-at-eol))) + (beg (max (point-min) (1- (line-beginning-position)))) + (end (line-end-position))) (let ((inhibit-read-only t)) (add-text-properties beg end `(invisible org-filtered org-filter-type ,type))))) @@ -8887,7 +8891,7 @@ When called with a prefix argument, include all archive files as well." (interactive "p") (let ((col (current-column))) (dotimes (_ n) - (when (next-single-property-change (point-at-eol) 'org-marker) + (when (next-single-property-change (line-end-position) 'org-marker) (move-end-of-line 1) (goto-char (next-single-property-change (point) 'org-marker)))) (org-move-to-column col)) @@ -8945,7 +8949,8 @@ When called with a prefix argument, include all archive files as well." (when (re-search-forward org-complex-heading-regexp nil t) (goto-char (match-beginning 4))))) (run-hooks 'org-agenda-after-show-hook) - (and highlight (org-highlight (point-at-bol) (point-at-eol))))) + (and highlight (org-highlight (line-beginning-position) + (line-end-position))))) (defvar org-agenda-after-show-hook nil "Normal hook run after an item has been shown from the agenda. @@ -8968,7 +8973,7 @@ deletes the agenda entry and don't move to the next entry." (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level) (org-get-at-bol 'level)))) (while (< (point) mend) - (let ((ov (make-overlay (point) (point-at-eol)))) + (let ((ov (make-overlay (point) (line-end-position)))) (if (not (or all (and match (looking-at-p match)) (eq level (org-get-at-bol 'level)))) @@ -9013,8 +9018,8 @@ Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'." (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) (setq dbeg (progn (org-back-to-heading t) (point)) dend (org-end-of-subtree t t)) - (setq dbeg (point-at-bol) - dend (min (point-max) (1+ (point-at-eol))))) + (setq dbeg (line-beginning-position) + dend (min (point-max) (1+ (line-end-position))))) (goto-char dbeg) (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) (when (or (eq t org-agenda-confirm-kill) @@ -9113,7 +9118,8 @@ If this information is not given, the function uses the tree at point." (>= p beg) (< p end)) (let ((inhibit-read-only t)) - (delete-region (point-at-bol) (1+ (point-at-eol))))) + (delete-region (line-beginning-position) + (1+ (line-end-position))))) (beginning-of-line 0)))))) (defun org-agenda-refile (&optional goto rfloc no-update) @@ -9162,7 +9168,8 @@ It also looks at the text of the entry itself." (let* ((marker (or (org-get-at-bol 'org-hd-marker) (org-get-at-bol 'org-marker))) (buffer (and marker (marker-buffer marker))) - (prefix (buffer-substring (point-at-bol) (point-at-eol))) + (prefix (buffer-substring (line-beginning-position) + (line-end-position))) (lkall (and buffer (org-offer-links-in-entry buffer marker arg prefix))) (lk0 (car lkall)) @@ -9295,7 +9302,7 @@ if it was hidden in the outline." (let ((win (selected-window))) (org-agenda-goto t) (org-back-to-heading) - (set-window-start (selected-window) (point-at-bol)) + (set-window-start (selected-window) (line-beginning-position)) (cond ((= more 0) (org-flag-subtree t) @@ -9532,7 +9539,8 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags." (with-current-buffer (marker-buffer hdmarker) (org-with-wide-buffer (org-agenda-format-item extra newhead level cat tags dotime)))) - ;; pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) + ;; pl (text-property-any (line-beginning-position) + ;; (line-end-position) 'org-heading t) undone-face (org-get-at-bol 'undone-face) done-face (org-get-at-bol 'done-face)) (beginning-of-line 1) @@ -9549,10 +9557,11 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags." (replace-match new t t) (beginning-of-line) (when mark (move-overlay mark (point) (+ 2 (point))))) - (add-text-properties (point-at-bol) (point-at-eol) props) + (add-text-properties (line-beginning-position) + (line-end-position) props) (when fixface (add-text-properties - (point-at-bol) (point-at-eol) + (line-beginning-position) (line-end-position) (list 'face (if org-last-todo-state-is-todo undone-face done-face)))) @@ -9560,7 +9569,7 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags." (beginning-of-line 1)) (t (error "Line update did not work"))) (save-restriction - (narrow-to-region (point-at-bol) (point-at-eol)) + (narrow-to-region (line-beginning-position) (line-end-position)) (org-agenda-finalize))) (beginning-of-line 0))))) @@ -9791,7 +9800,8 @@ When called programmatically, FORCE-DIRECTION can be `set', `up', (setq arg (- today cdate)))) (org-timestamp-change arg (or what 'day)) (when (and (org-at-date-range-p) - (re-search-backward org-tr-regexp-both (point-at-bol))) + (re-search-backward org-tr-regexp-both + (line-beginning-position))) (let ((end org-last-changed-timestamp)) (org-timestamp-change arg (or what 'day)) (setq org-last-changed-timestamp @@ -9846,7 +9856,7 @@ When called programmatically, FORCE-DIRECTION can be `set', `up', (length stamp)) t) (add-text-properties - (1- (point)) (point-at-eol) + (1- (point)) (line-end-position) (list 'display (org-add-props stamp nil 'face '(secondary-selection default)))) (beginning-of-line 1)) @@ -9990,13 +10000,13 @@ buffer, display it in another window." (if (equal (buffer-name) "*Calendar*") (setq d1 (calendar-cursor-to-date t) d2 (car calendar-mark-ring)) - (setq dp1 (get-text-property (point-at-bol) 'day)) + (setq dp1 (get-text-property (line-beginning-position) 'day)) (unless dp1 (user-error "No date defined in current line")) (setq d1 (calendar-gregorian-from-absolute dp1) d2 (and (ignore-errors (mark)) (save-excursion (goto-char (mark)) - (setq dp2 (get-text-property (point-at-bol) 'day))) + (setq dp2 (get-text-property (line-beginning-position) 'day))) (calendar-gregorian-from-absolute dp2)))) (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree") (setq char (read-char-exclusive)) @@ -10319,7 +10329,7 @@ This is a command that has to be installed in `calendar-mode-map'." (defun org-agenda-bulk-marked-p () "Non-nil when current entry is marked for bulk action." - (eq (get-char-property (point-at-bol) 'type) + (eq (get-char-property (line-beginning-position) 'type) 'org-marked-entry-overlay)) (defun org-agenda-bulk-mark (&optional arg) @@ -10344,7 +10354,8 @@ When ARG is greater than one mark ARG lines." (unless (org-agenda-bulk-marked-p) (unless m (user-error "Nothing to mark at point")) (push m org-agenda-bulk-marked-entries) - (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) + (setq ov (make-overlay (line-beginning-position) + (+ 2 (line-beginning-position)))) (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") (org-get-todo-face "TODO") 'evaporate) @@ -10388,7 +10399,7 @@ When ARG is greater than one mark ARG lines." (org-agenda-bulk-unmark-all) (cond ((org-agenda-bulk-marked-p) (org-agenda-bulk-remove-overlays - (point-at-bol) (+ 2 (point-at-bol))) + (line-beginning-position) (+ 2 (line-beginning-position))) (setq org-agenda-bulk-marked-entries (delete (org-get-at-bol 'org-hd-marker) org-agenda-bulk-marked-entries)) @@ -10768,8 +10779,8 @@ tag and note"))))) (message "Entry unflagged"))) (defun org-agenda-get-any-marker (&optional pos) - (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker) - (get-text-property (or pos (point-at-bol)) 'org-marker))) + (or (get-text-property (or pos (line-beginning-position)) 'org-hd-marker) + (get-text-property (or pos (line-beginning-position)) 'org-marker))) ;;; Appointment reminders diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 2fd9a9c74da..abf4f9610e7 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1447,7 +1447,7 @@ Of course, if exact position has been required, just put it there." (if (org-at-table-p) (save-excursion (org-table-goto-line (nth 1 where)) - (point-at-bol)) + (line-beginning-position)) (point)))))) (with-current-buffer (buffer-base-buffer (current-buffer)) (org-with-point-at pos diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index fdc9818a5a8..38e0826075b 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1317,7 +1317,7 @@ the default behavior." ;; Clock in at which position? (setq target-pos (if (and (eobp) (not (org-at-heading-p))) - (point-at-bol 0) + (line-beginning-position 0) (point))) (save-excursion (when (and selected-task (marker-buffer selected-task)) @@ -1666,7 +1666,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (setq ts (match-string 2)) (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) (goto-char (match-end 0)) - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) (insert "--") (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) (setq s (org-time-convert-to-integer @@ -1804,7 +1804,7 @@ Optional argument N tells to change by that many units." (goto-char org-clock-marker) (if (looking-back (concat "^[ \t]*" org-clock-string ".*") (line-beginning-position)) - (progn (delete-region (1- (point-at-bol)) (point-at-eol)) + (progn (delete-region (1- (line-beginning-position)) (line-end-position)) (org-remove-empty-drawer-at (point))) (message "Clock gone, cancel the timer anyway") (sit-for 2))) @@ -1946,7 +1946,7 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (aset ltimes l (+ (aref ltimes l) t1)))) (setq time (aref ltimes level)) (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) + (put-text-property (point) (line-end-position) (or propname :org-clock-minutes) time) (when headline-filter (save-excursion @@ -2114,7 +2114,7 @@ fontified, and then returned." (forward-line 2) (buffer-substring (point) (progn (re-search-forward "^[ \t]*#\\+END" nil t) - (point-at-bol))))) + (line-beginning-position))))) ;;;###autoload (defun org-clock-report (&optional arg) @@ -2390,7 +2390,7 @@ the currently selected interval size." (setq n (prefix-numeric-value n)) (and (memq dir '(left down)) (setq n (- n))) (save-excursion - (goto-char (point-at-bol)) + (goto-char (line-beginning-position)) (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) (user-error "Line needs a :block definition before this command works") (let* ((b (match-beginning 1)) (e (match-end 1)) @@ -3030,7 +3030,7 @@ Otherwise, return nil." ((not (match-end 2)) (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) (> org-clock-marker (point)) - (<= org-clock-marker (point-at-eol))) + (<= org-clock-marker (line-end-position))) ;; The clock is running here (setq org-clock-start-time (org-time-string-to-time (match-string 1))) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 085e32d6774..15f0daa91ae 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -1028,7 +1028,7 @@ To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'." (require 'org-agenda) (let (p m tp np dir txt) (cond - ((setq p (text-property-any (point-at-bol) (point-at-eol) + ((setq p (text-property-any (line-beginning-position) (line-end-position) 'org-imenu t)) (setq m (get-text-property p 'org-imenu-marker)) (with-current-buffer (marker-buffer m) @@ -1038,7 +1038,7 @@ To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'." (overlays-at (point)))) (org-agenda-remove-restriction-lock 'noupdate) (org-agenda-set-restriction-lock 'subtree)))) - ((setq p (text-property-any (point-at-bol) (point-at-eol) + ((setq p (text-property-any (line-beginning-position) (line-end-position) 'speedbar-function 'speedbar-find-file)) (setq tp (previous-single-property-change (1+ p) 'speedbar-function) @@ -1055,7 +1055,7 @@ To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'." (org-agenda-set-restriction-lock 'file))) (t (user-error "Don't know how to restrict Org mode agenda"))) (move-overlay org-speedbar-restriction-lock-overlay - (point-at-bol) (point-at-eol)) + (line-beginning-position) (line-end-position)) (setq current-prefix-arg nil) (org-agenda-maybe-redo))) diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 20b5b030392..4c018062af3 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -2205,7 +2205,7 @@ CDR is a plist containing `:key', `:value', `:begin', `:end', (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):") (upcase (match-string-no-properties 1)))) (value (org-trim (buffer-substring-no-properties - (match-end 0) (point-at-eol)))) + (match-end 0) (line-end-position)))) (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) @@ -4273,7 +4273,7 @@ This function assumes that current major mode is `org-mode'." (goto-char (point-min)) (org-skip-whitespace) (org-element--parse-elements - (point-at-bol) (point-max) + (line-beginning-position) (point-max) ;; Start in `first-section' mode so text before the first ;; headline belongs to a section. 'first-section nil granularity visible-only (list 'org-data nil)))) @@ -6207,12 +6207,12 @@ end of ELEM-A." (end-A (save-excursion (goto-char (org-element-property :end elem-A)) (skip-chars-backward " \r\t\n") - (point-at-eol))) + (line-end-position))) (beg-B (org-element-property :begin elem-B)) (end-B (save-excursion (goto-char (org-element-property :end elem-B)) (skip-chars-backward " \r\t\n") - (point-at-eol))) + (line-end-position))) ;; Store inner overlays responsible for visibility status. ;; We also need to store their boundaries as they will be ;; removed from buffer. diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index bc5175b1637..3bf4307f4a1 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -426,7 +426,7 @@ current time." (moment (org-time-subtract nil (* 3600 org-extend-today-until)))) (save-excursion - (goto-char (if line (point-at-bol) (point-min))) + (goto-char (if line (line-beginning-position) (point-min))) (while (not (eobp)) (let ((habit (get-text-property (point) 'org-habit-p)) (invisible-prop (get-text-property (point) 'invisible))) diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 581370bb53e..2cbbf7f7ac3 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -238,7 +238,7 @@ going below `org-inlinetask-min-level'." (setq beg (point)) (replace-match down-task nil t nil 1) (org-inlinetask-goto-end) - (if (and (eobp) (looking-back "END\\s-*" (point-at-bol))) + (if (and (eobp) (looking-back "END\\s-*" (line-beginning-position))) (beginning-of-line) (forward-line -1)) (unless (= (point) beg) @@ -264,7 +264,7 @@ If the task has an end part, also demote it." (setq beg (point)) (replace-match down-task nil t nil 1) (org-inlinetask-goto-end) - (if (and (eobp) (looking-back "END\\s-*" (point-at-bol))) + (if (and (eobp) (looking-back "END\\s-*" (line-beginning-position))) (beginning-of-line) (forward-line -1)) (unless (= (point) beg) @@ -312,7 +312,7 @@ If the task has an end part, also demote it." (if (bolp) (1- (point)) (point)))) (start (save-excursion (org-inlinetask-goto-beginning) - (point-at-eol)))) + (line-end-position)))) (cond ;; Nothing to show/hide. ((= end start)) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index da309f8c6da..978e36ed617 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -517,7 +517,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (and (not (looking-at beg-re)) (not (looking-at end-re)) (setq beg (and (re-search-backward beg-re lim-up t) - (1+ (point-at-eol)))) + (1+ (line-end-position)))) (setq end (or (and (re-search-forward end-re lim-down t) (1- (match-beginning 0))) lim-down)) @@ -528,12 +528,12 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (when (save-excursion (and (not (looking-at block-re)) (setq beg (and (re-search-backward block-re lim-up t) - (1+ (point-at-eol)))) + (1+ (line-end-position)))) (looking-at "^[ \t]*#\\+begin_\\(\\S-+\\)") (setq type (downcase (match-string 1))) (goto-char beg) (setq end (or (and (re-search-forward block-re lim-down t) - (1- (point-at-bol))) + (1- (line-beginning-position))) lim-down)) (>= end pos) (equal (downcase (match-string 1)) "end"))) @@ -547,7 +547,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (end-re (concat beg-re "END[ \t]*$"))) (and (not (looking-at "^\\*+")) (setq beg (and (re-search-backward beg-re lim-up t) - (1+ (point-at-eol)))) + (1+ (line-end-position)))) (not (looking-at end-re)) (setq end (and (re-search-forward end-re lim-down t) (1- (match-beginning 0)))) @@ -569,7 +569,7 @@ values are: 6. position at item end. Thus the following list, where numbers in parens are -point-at-bol: +line-beginning-position: - [X] first item (1) 1. sub-item 1 (18) @@ -617,7 +617,7 @@ Assume point is at an item." ;; Ensure list ends at the first blank line. (lambda () (skip-chars-backward " \r\t\n") - (min (1+ (point-at-eol)) lim-down)))) + (min (1+ (line-end-position)) lim-down)))) ;; 1. Read list from starting item to its beginning, and save ;; top item position and indentation in BEG-CELL. Also store ;; ending position of items in END-LST. @@ -872,7 +872,7 @@ Point returned is at end of line." (save-excursion (goto-char (org-list-get-item-end item struct)) (skip-chars-backward " \r\t\n") - (point-at-eol))) + (line-end-position))) (defun org-list-get-parent (item struct parents) "Return parent of ITEM or nil. @@ -1182,7 +1182,7 @@ some heuristics to guess the result." (lambda () ;; Count blank lines above beginning of line. (save-excursion - (count-lines (goto-char (point-at-bol)) + (count-lines (goto-char (line-beginning-position)) (progn (skip-chars-backward " \r\t\n") (forward-line) (point))))))) @@ -1287,7 +1287,7 @@ This function modifies STRUCT." ;; must be removed, or they will be left, stacking up ;; after the list. (when (< item-end pos) - (delete-region (1- item-end) (point-at-eol))) + (delete-region (1- item-end) (line-end-position))) (skip-chars-backward " \r\t\n") ;; Cut position is after any blank on the line. (save-excursion @@ -1364,7 +1364,7 @@ STRUCT is the list structure." (save-excursion (goto-char item) (skip-chars-backward " \r\t\n") - (min (1+ (point-at-eol)) (point-max))) + (min (1+ (line-end-position)) (point-max))) item))) ;; Remove item from buffer. (delete-region beg end) @@ -1441,7 +1441,7 @@ This function returns, destructively, the new list structure." (setq dest (org-list-get-list-end item struct prevs)) (save-excursion (goto-char (org-list-get-last-item item struct prevs)) - (point-at-eol))) + (line-end-position))) ((and (stringp dest) (string-match-p "\\`[0-9]+\\'" dest)) (let* ((all (org-list-get-all-items item struct prevs)) (len (length all)) @@ -1453,7 +1453,7 @@ This function returns, destructively, the new list structure." (save-excursion (goto-char (org-list-get-last-item item struct prevs)) - (point-at-eol))))) + (line-end-position))))) (t dest))) (org-M-RET-may-split-line nil) ;; Store inner overlays (to preserve visibility). @@ -1880,7 +1880,7 @@ Initial position of cursor is restored after the changes." (insert (concat new-box (unless counterp " ")))))) ;; c. Indent item to appropriate column. (unless (= new-ind old-ind) - (delete-region (goto-char (point-at-bol)) + (delete-region (goto-char (line-beginning-position)) (progn (skip-chars-forward " \t") (point))) (indent-to new-ind)))))) ;; 1. First get list of items and position endings. We maintain @@ -2010,7 +2010,7 @@ Sublists of the list are skipped. Cursor is always at the beginning of the item." (let* ((struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) - (item (copy-marker (point-at-bol))) + (item (copy-marker (line-beginning-position))) (all (org-list-get-all-items (marker-position item) struct prevs)) (value init-value)) (dolist (e (nreverse all)) @@ -2147,10 +2147,10 @@ the item, so this really moves item trees." (interactive) (unless (org-at-item-p) (error "Not at an item")) (let* ((col (current-column)) - (item (point-at-bol)) + (item (line-beginning-position)) (struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) - (next-item (org-list-get-next-item (point-at-bol) struct prevs))) + (next-item (org-list-get-next-item (line-beginning-position) struct prevs))) (unless (or next-item org-list-use-circular-motion) (user-error "Cannot move this item further down")) (if (not next-item) @@ -2168,10 +2168,10 @@ the item, so this really moves item trees." (interactive) (unless (org-at-item-p) (error "Not at an item")) (let* ((col (current-column)) - (item (point-at-bol)) + (item (line-beginning-position)) (struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) - (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) + (prev-item (org-list-get-prev-item (line-beginning-position) struct prevs))) (unless (or prev-item org-list-use-circular-motion) (user-error "Cannot move this item further up")) (if (not prev-item) @@ -2312,7 +2312,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (old-struct (copy-tree struct)) (cbox (org-list-get-checkbox cpos struct)) (prevs (org-list-prevs-alist struct)) - (start (org-list-get-list-begin (point-at-bol) struct prevs)) + (start (org-list-get-list-begin (line-beginning-position) struct prevs)) (new (unless (and cbox (equal arg '(4)) (equal start cpos)) "[ ]"))) (dolist (pos (org-list-get-all-items @@ -2372,7 +2372,7 @@ subtree, ignoring planning line and any drawer following it." (let ((limit (region-end))) (goto-char (region-beginning)) (if (org-list-search-forward (org-item-beginning-re) limit t) - (setq lim-up (point-at-bol)) + (setq lim-up (line-beginning-position)) (error "No item in region")) (setq lim-down (copy-marker limit)))) ((org-at-heading-p) @@ -2381,14 +2381,14 @@ subtree, ignoring planning line and any drawer following it." (let ((limit (save-excursion (outline-next-heading) (point)))) (org-end-of-meta-data t) (if (org-list-search-forward (org-item-beginning-re) limit t) - (setq lim-up (point-at-bol)) + (setq lim-up (line-beginning-position)) (error "No item in subtree")) (setq lim-down (copy-marker limit)))) ;; Just one item: set SINGLEP flag. ((org-at-item-p) (setq singlep t) - (setq lim-up (point-at-bol) - lim-down (copy-marker (point-at-eol)))) + (setq lim-up (line-beginning-position) + lim-down (copy-marker (line-end-position)))) (t (error "Not at an item or heading, and no active region")))) ;; Determine the checkbox going to be applied to all items ;; within bounds. @@ -2636,7 +2636,7 @@ Return t if successful." ;; Are we going to move the whole list? (specialp (and (not regionp) - (= top (point-at-bol)) + (= top (line-beginning-position)) (cdr (assq 'indent org-list-automatic-rules)) (if no-subtree (user-error @@ -2650,12 +2650,12 @@ Return t if successful." (progn (set-marker org-last-indent-begin-marker rbeg) (set-marker org-last-indent-end-marker rend)) - (set-marker org-last-indent-begin-marker (point-at-bol)) + (set-marker org-last-indent-begin-marker (line-beginning-position)) (set-marker org-last-indent-end-marker (cond (specialp (org-list-get-bottom-point struct)) - (no-subtree (1+ (point-at-bol))) - (t (org-list-get-item-end (point-at-bol) struct)))))) + (no-subtree (1+ (line-beginning-position))) + (t (org-list-get-item-end (line-beginning-position) struct)))))) (let* ((beg (marker-position org-last-indent-begin-marker)) (end (marker-position org-last-indent-end-marker))) (cond @@ -2893,8 +2893,8 @@ function is being called interactively." (let* ((case-func (if with-case 'identity 'downcase)) (struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) - (start (org-list-get-list-begin (point-at-bol) struct prevs)) - (end (org-list-get-list-end (point-at-bol) struct prevs)) + (start (org-list-get-list-begin (line-beginning-position) struct prevs)) + (end (org-list-get-list-end (line-beginning-position) struct prevs)) (sorting-type (or sorting-type (progn @@ -2939,21 +2939,21 @@ function is being called interactively." ((= dcst ?n) (string-to-number (org-sort-remove-invisible - (buffer-substring (match-end 0) (point-at-eol))))) + (buffer-substring (match-end 0) (line-end-position))))) ((= dcst ?a) (funcall case-func (org-sort-remove-invisible (buffer-substring - (match-end 0) (point-at-eol))))) + (match-end 0) (line-end-position))))) ((= dcst ?t) (cond ;; If it is a timer list, convert timer to seconds ((org-at-item-timer-p) (org-timer-hms-to-secs (match-string 1))) ((or (save-excursion - (re-search-forward org-ts-regexp (point-at-eol) t)) + (re-search-forward org-ts-regexp (line-end-position) t)) (save-excursion (re-search-forward org-ts-regexp-both - (point-at-eol) t))) + (line-end-position) t))) (org-time-string-to-seconds (match-string 0))) (t (float-time now)))) ((= dcst ?x) (or (and (stringp (match-string 1)) @@ -3026,14 +3026,14 @@ With a prefix argument ARG, change the region in a single item." (save-excursion (goto-char pos) (skip-chars-forward " \r\t\n") - (point-at-bol)))) + (line-beginning-position)))) beg end) ;; Determine boundaries of changes. (if (org-region-active-p) (setq beg (funcall skip-blanks (region-beginning)) end (copy-marker (region-end))) - (setq beg (point-at-bol) - end (copy-marker (point-at-eol)))) + (setq beg (line-beginning-position) + end (copy-marker (line-end-position)))) ;; Depending on the starting line, choose an action on the text ;; between BEG and END. (org-with-limited-levels diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index bb0562dde06..cf0eb48f2da 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -1124,11 +1124,11 @@ the value in cadr." (defsubst org-get-at-bol (property) "Get text property PROPERTY at the beginning of line." - (get-text-property (point-at-bol) property)) + (get-text-property (line-beginning-position) property)) (defun org-get-at-eol (property n) "Get text property PROPERTY at the end of line less N characters." - (get-text-property (- (point-at-eol) n) property)) + (get-text-property (- (line-end-position) n) property)) (defun org-find-text-property-in-string (prop s) "Return the first non-nil value of property PROP in string S." diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 5cfaa7fe0ae..6f0a60125c5 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -617,7 +617,7 @@ The table of checksums is written to the file mobile-checksums." ((looking-at "[ \t]*$")) ; keep empty lines ((looking-at "=+$") ;; remove underlining - (delete-region (point) (point-at-eol))) + (delete-region (point) (line-end-position))) ((get-text-property (point) 'org-agenda-structural-header) (setq in-date nil) (setq app (get-text-property (point) 'org-agenda-title-append)) @@ -637,14 +637,14 @@ The table of checksums is written to the file mobile-checksums." (get-text-property (point) 'org-marker))) (setq sexp (member (get-text-property (point) 'type) '("diary" "sexp"))) - (if (setq pl (text-property-any (point) (point-at-eol) 'org-heading t)) + (if (setq pl (text-property-any (point) (line-end-position) 'org-heading t)) (progn (setq prefix (org-trim (buffer-substring (point) pl)) line (org-trim (buffer-substring pl - (point-at-eol)))) - (delete-region (point-at-bol) (point-at-eol)) + (line-end-position)))) + (delete-region (line-beginning-position) (line-end-position)) (insert line "<before>" prefix "</before>") (beginning-of-line 1)) (and (looking-at "[ \t]+") (replace-match ""))) @@ -857,7 +857,7 @@ If BEG and END are given, only do this in that region." (org-mobile-timestamp-buffer (marker-buffer id-pos)) (push (marker-buffer id-pos) buf-list)) (unless (markerp id-pos) - (goto-char (+ 2 (point-at-bol))) + (goto-char (+ 2 (line-beginning-position))) (if (stringp id-pos) (insert id-pos " ") (insert "BAD REFERENCE ")) @@ -1093,7 +1093,7 @@ be returned that indicates what went wrong." (org-archive-to-archive-sibling)) ((eq what 'body) - (setq current (buffer-substring (min (1+ (point-at-eol)) (point-max)) + (setq current (buffer-substring (min (1+ (line-end-position)) (point-max)) (save-excursion (outline-next-heading) (point)))) (if (not (string-match "\\S-" current)) (setq current nil)) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index a590ff87f24..aa4c20050ff 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -184,7 +184,7 @@ Changing this variable requires a restart of Emacs to get activated." (defun org-mouse-re-search-line (regexp) "Search the current line for a given regular expression." (beginning-of-line) - (re-search-forward regexp (point-at-eol) t)) + (re-search-forward regexp (line-end-position) t)) (defun org-mouse-end-headline () "Go to the end of current headline (ignoring tags)." @@ -574,7 +574,7 @@ This means, between the beginning of line and the point." (insert "+ ")) (:end ; insert text here (skip-chars-backward " \t") - (kill-region (point) (point-at-eol)) + (kill-region (point) (line-end-position)) (unless (looking-back org-mouse-punctuation (line-beginning-position)) (insert (concat org-mouse-punctuation " "))))) (insert text) @@ -985,7 +985,7 @@ This means, between the beginning of line and the point." (defun org-mouse-do-remotely (command) ;; (org-agenda-check-no-diary) (when (get-text-property (point) 'org-marker) - (let* ((anticol (- (point-at-eol) (point))) + (let* ((anticol (- (line-end-position) (point))) (marker (get-text-property (point) 'org-marker)) (buffer (marker-buffer marker)) (pos (marker-position marker)) @@ -1009,7 +1009,7 @@ This means, between the beginning of line and the point." (org-flag-heading nil))) ; show the next heading (org-back-to-heading) (setq marker (point-marker)) - (goto-char (max (point-at-bol) (- (point-at-eol) anticol))) + (goto-char (max (line-beginning-position) (- (line-end-position) anticol))) (funcall command) (message "_cmd: %S" org-mouse-cmd) (message "this-command: %S" this-command) diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 831c84befcb..1912f6762ae 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -621,7 +621,8 @@ manner suitable for prepending to a user-specified script." "Find any overlays for IMG-FILE in the current Org buffer, and refresh them." (dolist (img-overlay org-inline-image-overlays) (when (string= img-file (plist-get (cdr (overlay-get img-overlay 'display)) :file)) - (when (file-exists-p img-file) + (when (and (file-exists-p img-file) + (fboundp 'image-flush)) (image-flush (overlay-get img-overlay 'display)))))) ;;----------------------------------------------------------------------------- diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index 71d00a7a22b..3b3344b2709 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -465,9 +465,9 @@ prefix argument (`C-u C-u C-u C-c C-w')." (unless (or (org-kill-is-subtree-p (buffer-substring region-start region-end)) (prog1 org-refile-active-region-within-subtree - (let ((s (point-at-eol))) + (let ((s (line-end-position))) (org-toggle-heading) - (setq region-end (+ (- (point-at-eol) s) region-end))))) + (setq region-end (+ (- (line-end-position) s) region-end))))) (user-error "The region is not a (sequence of) subtree(s)"))) (if (equal arg '(16)) (org-refile-goto-last-stored) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index c301bc6af1a..9b692d09736 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -486,7 +486,7 @@ This may be useful when columns have been shrunk." (looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>")) (move-beginning-of-line 2)) (line-beginning-position))) - (end (save-excursion (goto-char beg) (point-at-eol)))) + (end (save-excursion (goto-char beg) (line-end-position)))) (if (pos-visible-in-window-p beg) (when (overlayp org-table-header-overlay) (delete-overlay org-table-header-overlay)) @@ -825,7 +825,7 @@ SIZE is a string Columns x Rows like for example \"3x2\"." (line (concat (apply 'concat indent "|" (make-list columns " |")) "\n"))) (if (string-match "^[ \t]*$" (buffer-substring-no-properties - (point-at-bol) (point))) + (line-beginning-position) (point))) (beginning-of-line 1) (newline)) ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) @@ -1087,7 +1087,7 @@ With numeric argument N, move N-1 fields backward first." (while (> n 1) (setq n (1- n)) (org-table-previous-field)) - (if (not (re-search-backward "|" (point-at-bol 0) t)) + (if (not (re-search-backward "|" (line-beginning-position 0) t)) (user-error "No more table fields before the current") (goto-char (match-end 0)) (and (looking-at " ") (forward-char 1))) @@ -1102,7 +1102,7 @@ With numeric argument N, move N-1 fields forward first." (while (> n 1) (setq n (1- n)) (org-table-next-field)) - (when (re-search-forward "|" (point-at-eol 1) t) + (when (re-search-forward "|" (line-end-position 1) t) (backward-char 1) (skip-chars-backward " ") (when (and (equal (char-before (point)) ?|) (equal (char-after (point)) ?\s)) @@ -1159,7 +1159,7 @@ When ALIGN is set, also realign the table." (goto-char (org-table-begin)) (while (and (re-search-forward org-table-dataline-regexp end t) (setq cnt (1+ cnt)) - (< (point-at-eol) pos)))) + (< (line-end-position) pos)))) cnt)) (defun org-table-current-column () @@ -1322,7 +1322,7 @@ However, when FORCE is non-nil, create new columns if necessary." (beginning-of-line 1) (when (> n 0) (while (and (> (setq n (1- n)) -1) - (or (search-forward "|" (point-at-eol) t) + (or (search-forward "|" (line-end-position) t) (and force (progn (end-of-line 1) (skip-chars-backward "^|") @@ -1663,7 +1663,7 @@ With prefix ABOVE, insert above the current line." (org-table-align)) (org-table-with-shrunk-columns (let ((line (org-table-clean-line - (buffer-substring (point-at-bol) (point-at-eol)))) + (buffer-substring (line-beginning-position) (line-end-position)))) (col (current-column))) (while (string-match "|\\( +\\)|" line) (setq line (replace-match @@ -1712,7 +1712,8 @@ In particular, this does handle wide and invisible characters." (dline (and (not (org-match-line org-table-hline-regexp)) (org-table-current-dline)))) (org-table-with-shrunk-columns - (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) + (kill-region (line-beginning-position) + (min (1+ (line-end-position)) (point-max))) (if (not (org-at-table-p)) (beginning-of-line 0)) (org-move-to-column col) (when (and dline @@ -2253,14 +2254,14 @@ For all numbers larger than LIMIT, shift them by DELTA." (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) s n a) (when remove - (while (re-search-forward re2 (point-at-eol) t) + (while (re-search-forward re2 (line-end-position) t) (unless (save-match-data (org-in-regexp "remote([^)]+?)")) (if (equal (char-before (match-beginning 0)) ?.) (user-error "Change makes TBLFM term %s invalid, use undo to recover" (match-string 0)) (replace-match ""))))) - (while (re-search-forward re (point-at-eol) t) + (while (re-search-forward re (line-end-position) t) (unless (save-match-data (org-in-regexp "remote([^)]+?)")) (setq s (match-string 1) n (string-to-number s)) (cond @@ -3789,8 +3790,9 @@ FACE, when non-nil, for the highlight." (let ((id 0) (ih 0) hline eol str ov) (goto-char (org-table-begin)) (while (org-at-table-p) - (setq eol (point-at-eol)) - (setq ov (make-overlay (point-at-bol) (1+ (point-at-bol)))) + (setq eol (line-end-position)) + (setq ov (make-overlay (line-beginning-position) + (1+ (line-beginning-position)))) (push ov org-table-coordinate-overlays) (setq hline (looking-at org-table-hline-regexp)) (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) @@ -4923,7 +4925,7 @@ When LOCAL is non-nil, show references for the table at point." ((not local) nil) (t (user-error "No reference at point"))) match (and what (or match (match-string 0)))) - (when (and match (not (equal (match-beginning 0) (point-at-bol)))) + (when (and match (not (equal (match-beginning 0) (line-beginning-position)))) (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) 'secondary-selection)) (add-hook 'before-change-functions diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 915c3f63c7d..353d533c06c 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made." (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5.4-17-g6e991f")) + (let ((org-git-version "release_9.5.4-19-g4dff42")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index df708a2159d..9facbed04de 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -5971,7 +5971,7 @@ and subscripts." (emph-p (get-text-property mpos 'org-emphasis)) (link-p (get-text-property mpos 'mouse-face)) (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) - (goto-char (point-at-bol)) + (goto-char (line-beginning-position)) (setq table-p (looking-at-p org-table-dataline-regexp) comment-p (looking-at-p "^[ \t]*#[ +]")) (goto-char pos) @@ -6443,7 +6443,7 @@ Use `\\[org-edit-special]' to edit table.el tables")) (and (memq org-cycle-emulate-tab '(white whitestart)) (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) (or (and (eq org-cycle-emulate-tab 'white) - (= (match-end 0) (point-at-eol))) + (= (match-end 0) (line-end-position))) (and (eq org-cycle-emulate-tab 'whitestart) (>= (match-end 0) pos))))) (call-interactively (global-key-binding (kbd "TAB")))) @@ -6498,7 +6498,7 @@ Use `\\[org-edit-special]' to edit table.el tables")) (progn (beginning-of-line) (setq struct (org-list-struct)) - (setq eoh (point-at-eol)) + (setq eoh (line-end-position)) (setq eos (org-list-get-item-end-before-blank (point) struct)) (setq has-children (org-list-has-child-p (point) struct))) (org-back-to-heading) @@ -6545,7 +6545,7 @@ Use `\\[org-edit-special]' to edit table.el tables")) (unless (org-before-first-heading-p) (run-hook-with-args 'org-pre-cycle-hook 'children)) (if (org-at-item-p) - (org-list-set-item-visibility (point-at-bol) struct 'children) + (org-list-set-item-visibility (line-beginning-position) struct 'children) (org-show-entry) (org-with-limited-levels (org-show-children)) (org-show-set-visibility 'tree) @@ -6729,7 +6729,7 @@ This function is the default value of the hook `org-cycle-hook'." (org-get-next-sibling) (org-get-next-sibling)) (if (org-at-heading-p) - (point-at-eol) + (line-end-position) (point)))) (level (looking-at "\\*+")) (re (when level (concat "^" (regexp-quote (match-string 0)) " ")))) @@ -7147,7 +7147,7 @@ This is a list with the following elements: "Get the entry text, after heading, entire subtree." (save-excursion (org-back-to-heading t) - (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) + (buffer-substring (line-beginning-position 2) (org-end-of-subtree t)))) (defun org-edit-headline (&optional heading) "Edit the current headline. @@ -8402,7 +8402,7 @@ function is being called interactively." (org-time-string-to-seconds (match-string 1)) (float-time now)))) ((= dcst ?p) - (if (re-search-forward org-priority-regexp (point-at-eol) t) + (if (re-search-forward org-priority-regexp (line-end-position) t) (string-to-char (match-string 2)) org-priority-default)) ((= dcst ?r) @@ -9244,7 +9244,8 @@ If not found, stay at current position and return nil." (defun org-create-dblock (plist) "Create a dynamic block section, with parameters taken from PLIST. PLIST must contain a :name entry which is used as the name of the block." - (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol))) + (when (string-match "\\S-" (buffer-substring (line-beginning-position) + (line-end-position))) (end-of-line 1) (newline)) (let ((col (current-column)) @@ -9908,7 +9909,8 @@ When called through ELisp, arg is also interpreted in the following way: (run-hooks 'org-after-todo-state-change-hook) (when (and arg (not (member org-state org-done-keywords))) (setq head (org-get-todo-sequence-head org-state))) - (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) + (put-text-property (line-beginning-position) + (line-end-position) 'org-todo-head head) ;; Do we need to trigger a repeat? (when now-done-p (when (boundp 'org-agenda-headline-snapshot-before-repeat) @@ -10121,7 +10123,7 @@ all statistics cookies in the buffer." (beginning-of-line 1) (while (re-search-forward "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)" - (point-at-eol) t) + (line-end-position) t) (replace-match (if (match-end 2) "[100%]" "[0/0]") t t))))) (goto-char pos) (move-marker pos nil))))) @@ -10168,7 +10170,7 @@ statistics everywhere." (downcase (or (org-entry-get nil "COOKIE_DATA") ""))))) (throw 'exit nil)) - (while (re-search-forward box-re (point-at-eol) t) + (while (re-search-forward box-re (line-end-position) t) (setq cnt-all 0 cnt-done 0 cookie-present t) (setq is-percent (match-end 2) checkbox-beg (match-beginning 0)) (save-match-data @@ -10277,10 +10279,11 @@ right sequence." (let (p) (cond ((not kwd) - (or (get-text-property (point-at-bol) 'org-todo-head) + (or (get-text-property (line-beginning-position) 'org-todo-head) (progn - (setq p (next-single-property-change (point-at-bol) 'org-todo-head - nil (point-at-eol))) + (setq p (next-single-property-change (line-beginning-position) + 'org-todo-head + nil (line-end-position))) (get-text-property p 'org-todo-head)))) ((not (member kwd org-todo-keywords-1)) (car org-todo-keywords-1)) @@ -10736,13 +10739,13 @@ nil." (outline-next-heading) (while (re-search-backward re beg t) (replace-match "") - (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) + (if (and (string-match "\\S-" (buffer-substring (line-beginning-position) (point))) (equal (char-before) ?\ )) (backward-delete-char 1) (when (string-match "^[ \t]*$" (buffer-substring - (point-at-bol) (point-at-eol))) - (delete-region (point-at-bol) - (min (point-max) (1+ (point-at-eol)))))))))) + (line-beginning-position) (line-end-position))) + (delete-region (line-beginning-position) + (min (point-max) (1+ (line-end-position)))))))))) (defvar org-time-was-given) ; dynamically scoped parameter (defvar org-end-time-was-given) ; dynamically scoped parameter @@ -12216,7 +12219,7 @@ Also insert END." (defun org-fast-tag-show-exit (flag) (save-excursion (org-goto-line 3) - (when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) + (when (re-search-forward "[ \t]+Next change exits" (line-end-position) t) (replace-match "")) (when flag (end-of-line 1) @@ -12263,7 +12266,7 @@ Returns the new tags string, or nil to not change the current settings." (setq ov-start (match-beginning 1) ov-end (match-end 1) ov-prefix "") - (setq ov-start (1- (point-at-eol)) + (setq ov-start (1- (line-end-position)) ov-end (1+ ov-start)) (skip-chars-forward "^\n\r") (setq ov-prefix @@ -12422,7 +12425,7 @@ Returns the new tags string, or nil to not change the current settings." (when (eq exit-after-next 'now) (throw 'exit t)) (goto-char (point-min)) (beginning-of-line 2) - (delete-region (point) (point-at-eol)) + (delete-region (point) (line-end-position)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (let ((tag-re (concat "\\[.\\] \\(" org-tag-re "\\)"))) @@ -14082,7 +14085,8 @@ user." (max (point-min) (- (point) 4)) (point)) " ")) (insert " "))) - (let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) + (let* ((ans (concat (buffer-substring (line-beginning-position) + (point-max)) " " (or org-ans1 org-ans2))) (org-end-time-was-given nil) (f (org-read-date-analyze ans org-def org-defdecode)) @@ -14104,7 +14108,7 @@ user." (when org-read-date-analyze-futurep (setq txt (concat txt " (=>F)"))) (setq org-read-date-overlay - (make-overlay (1- (point-at-eol)) (point-at-eol))) + (make-overlay (1- (line-end-position)) (line-end-position))) (org-overlay-display org-read-date-overlay txt 'secondary-selection))))) (defun org-read-date-analyze (ans def defdecode) @@ -14654,8 +14658,8 @@ days in order to avoid rounding problems." (org-clock-update-time-maybe) (save-excursion (unless (org-at-date-range-p t) - (goto-char (point-at-bol)) - (re-search-forward org-tr-regexp-both (point-at-eol) t)) + (goto-char (line-beginning-position)) + (re-search-forward org-tr-regexp-both (line-end-position) t)) (unless (org-at-date-range-p t) (user-error "Not at a time-stamp range, and none found in current line"))) (let* ((ts1 (match-string 1)) @@ -15719,7 +15723,8 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (goto-char (point-min)) (while (re-search-forward rea nil t) (when (org-at-heading-p t) - (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) + (add-text-properties (line-beginning-position) + (org-end-of-subtree t) pa)))) (goto-char (point-min)) (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string)) (while (re-search-forward re nil t) @@ -17231,14 +17236,14 @@ this function returns t, nil otherwise." (save-excursion (catch 'exit (unless (org-region-active-p) - (setq beg (point-at-bol)) + (setq beg (line-beginning-position)) (beginning-of-line 2) (while (and (not (eobp)) ;; this is like `next-line' (get-char-property (1- (point)) 'invisible)) (beginning-of-line 2)) (setq end (point)) (goto-char beg) - (goto-char (point-at-eol)) + (goto-char (line-end-position)) (setq end (max end (point))) (while (re-search-forward re end t) (when (get-char-property (match-beginning 0) 'invisible) @@ -18160,7 +18165,7 @@ number of stars to add." (goto-char pos) (while (org-at-comment-p) (forward-line)) (skip-chars-forward " \r\t\n") - (point-at-bol)))) + (line-beginning-position)))) beg end toggled) ;; Determine boundaries of changes. If a universal prefix has ;; been given, put the list in a region. If region ends at a bol, @@ -18174,9 +18179,9 @@ number of stars to add." (setq beg (funcall skip-blanks (region-beginning)) end (copy-marker (save-excursion (goto-char (region-end)) - (if (bolp) (point) (point-at-eol))))) - (setq beg (funcall skip-blanks (point-at-bol)) - end (copy-marker (point-at-eol)))) + (if (bolp) (point) (line-end-position))))) + (setq beg (funcall skip-blanks (line-beginning-position)) + end (copy-marker (line-end-position)))) ;; Ensure inline tasks don't count as headings. (org-with-limited-levels (save-excursion @@ -18787,7 +18792,9 @@ and :keyword." ;; First the large context (cond ((org-at-heading-p t) - (push (list :headline (point-at-bol) (point-at-eol)) clist) + (push (list :headline (line-beginning-position) + (line-end-position)) + clist) (when (progn (beginning-of-line 1) (looking-at org-todo-line-tags-regexp)) @@ -18801,7 +18808,7 @@ and :keyword." ((org-at-item-p) (push (org-point-in-group p 2 :item-bullet) clist) - (push (list :item (point-at-bol) + (push (list :item (line-beginning-position) (save-excursion (org-end-of-item) (point))) clist) (and (org-at-item-checkbox-p) @@ -19198,7 +19205,7 @@ Also align node properties according to `org-property-format'." (beginning-of-line 1) (skip-chars-backward "\n") (or (org-at-heading-p) - (looking-back ":END:.*" (point-at-bol)))))) + (looking-back ":END:.*" (line-beginning-position)))))) (let* ((element (save-excursion (beginning-of-line) (org-element-at-point))) (type (org-element-type element))) (cond ((and (memq type '(plain-list item)) @@ -19938,7 +19945,7 @@ major mode." (point)))) (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim)) (beginning-of-line) - (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol)) + (if (looking-at "\\s-*$") (delete-region (point) (line-end-position)) (open-line 1)) (org-indent-line) (insert "# "))) @@ -20431,7 +20438,7 @@ interactive command with similar behavior." (and (looking-at "[ \t]*$") (string-match "\\`\\*+\\'" - (buffer-substring (point-at-bol) (point))))))) + (buffer-substring (line-beginning-position) (point))))))) swallowp) (cond ((and subtreep org-yank-folded-subtrees) @@ -20464,7 +20471,7 @@ interactive command with similar behavior." (beginning-of-line 1) (push-mark beg 'nomsg))) ((and subtreep org-yank-adjusted-subtrees) - (let ((beg (point-at-bol))) + (let ((beg (line-beginning-position))) (org-paste-subtree nil nil 'for-yank) (push-mark beg 'nomsg))) (t diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el index a3fe31d7b8f..7a62145076b 100644 --- a/lisp/org/ox-icalendar.el +++ b/lisp/org/ox-icalendar.el @@ -276,14 +276,14 @@ re-read the iCalendar file.") ;;; Define Back-End (org-export-define-derived-backend 'icalendar 'ascii - :translate-alist '((clock . ignore) - (footnote-definition . ignore) - (footnote-reference . ignore) + :translate-alist '((clock . nil) + (footnote-definition . nil) + (footnote-reference . nil) (headline . org-icalendar-entry) (inner-template . org-icalendar-inner-template) - (inlinetask . ignore) - (planning . ignore) - (section . ignore) + (inlinetask . nil) + (planning . nil) + (section . nil) (template . org-icalendar-template)) :options-alist '((:exclude-tags diff --git a/lisp/paren.el b/lisp/paren.el index 4c268dbf771..d7580de9a9d 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -149,7 +149,8 @@ use `show-paren-local-mode'." ;;;###autoload (define-minor-mode show-paren-local-mode "Toggle `show-paren-mode' only in this buffer." - :variable (buffer-local-value 'show-paren-mode (current-buffer)) + :variable ( show-paren-mode . + (lambda (val) (setq-local show-paren-mode val))) (cond ((eq show-paren-mode (default-value 'show-paren-mode)) (unless show-paren-mode diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 6dba733b9c4..167cb4fabe8 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -570,11 +570,12 @@ the height of the current window." (window-header-line-height) (- max-y delta)))) (point (posn-point posn)) - (up-point (save-excursion - (goto-char point) - (vertical-motion (- (1+ scroll-margin))) - (point)))) - (when (> (point) up-point) + (up-point (and point + (save-excursion + (goto-char point) + (vertical-motion (- (1+ scroll-margin))) + (point))))) + (when (and point (> (point) up-point)) (when (let ((pos-visible (pos-visible-in-window-p up-point nil t))) (or (eq (length pos-visible) 2) (when-let* ((posn (posn-at-point up-point)) @@ -665,10 +666,11 @@ window being scrolled by DELTA pixels with an animation." "Scroll the current window up by DELTA pixels." (let ((max-height (- (window-text-height nil t) (frame-char-height)))) - (while (> delta max-height) - (pixel-scroll-precision-scroll-up-page max-height) - (setq delta (- delta max-height))) - (pixel-scroll-precision-scroll-up-page delta))) + (when (> max-height 0) + (while (> delta max-height) + (pixel-scroll-precision-scroll-up-page max-height) + (setq delta (- delta max-height))) + (pixel-scroll-precision-scroll-up-page delta)))) ;; FIXME: This doesn't _always_ work when there's an image above the ;; current line that is taller than the window, and scrolling can diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index bb3369de5fc..c9bd8ea9fe1 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -445,7 +445,7 @@ The most useful commands are: (let ((font-lock-fontify-region-function #'ignore)) ;; insert-and-inherit will pick the right face automatically (while (search-forward-regexp "^:" nil t) - (setq bound (point-at-eol)) + (setq bound (line-end-position)) (while (search-forward cipher-string bound 'end) (decipher-insert plain-char))))))) diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 7a850b07ee4..8cff67c5bcc 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -1,6 +1,6 @@ ;;; gamegrid.el --- library for implementing grid-based games on Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1997-1998, 2001-2022 Free Software Foundation, Inc. +;; Copyright (C) 1997-2022 Free Software Foundation, Inc. ;; Author: Glynn Clements <glynn@sensei.co.uk> ;; Old-Version: 1.02 @@ -72,7 +72,7 @@ directory will be used.") (defvar gamegrid-mono-x-face nil) (defvar gamegrid-mono-tty-face nil) -(defvar gamegrid-glyph-height-mm 7.0 +(defvar gamegrid-glyph-height-mm 5.0 "Desired glyph height in mm.") ;; ;;;;;;;;;;;;; glyph generation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -80,12 +80,24 @@ directory will be used.") (defun gamegrid-calculate-glyph-size () "Calculate appropriate glyph size in pixels based on display resolution. Return a multiple of 8 no less than 16." - (if (and (display-pixel-height) (display-mm-height)) - (let* ((y-pitch (/ (display-pixel-height) (float (display-mm-height)))) - (pixels (* y-pitch gamegrid-glyph-height-mm)) - (rounded (* (floor (/ (+ pixels 4) 8)) 8))) - (max 16 rounded)) - 16)) + (let (atts + y-pitch) + (dolist (mon (display-monitor-attributes-list)) + (when-let ((frames (alist-get 'frames mon)) + (match (memq (selected-frame) frames))) + (setq atts mon))) + (setq y-pitch (cond + (atts + (/ (nth 4 (assq 'geometry atts)) + (nth 2 (assq 'mm-size atts)) + (or (cdr (assq 'scale-factor atts)) 1.0))) + ((and (display-pixel-height) (display-mm-height)) + (/ (display-pixel-height) (float (display-mm-height)))))) + (if y-pitch + (let* ((pixels (* y-pitch gamegrid-glyph-height-mm)) + (rounded (* (floor (/ (+ pixels 4) 8)) 8))) + (max 16 rounded)) + 16))) ;; Example of glyph in XPM format: ;; @@ -251,7 +263,7 @@ format." (set-face-foreground face color) (set-face-background face color) (gamegrid-set-font face) - (set-face-background-pixmap face nil)) + (set-face-stipple face nil)) (defun gamegrid-make-mono-tty-face () (let ((face (make-face 'gamegrid-mono-tty-face))) @@ -335,8 +347,11 @@ format." (gamegrid-match-spec-list (cdr spec-list))))) (defun gamegrid-make-glyph (data-spec-list color-spec-list) + ;; image.el is not preloaded in --without-x builds. + (defvar image-scaling-factor) (let ((data (gamegrid-match-spec-list data-spec-list)) - (color (gamegrid-match-spec-list color-spec-list))) + (color (gamegrid-match-spec-list color-spec-list)) + (image-scaling-factor 1.0)) (cond ((characterp data) (vector data)) ((eq data 'colorize) diff --git a/lisp/printing.el b/lisp/printing.el index 534b45c772b..d10de24e03c 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -3040,7 +3040,7 @@ A. Interface: I. PostScript printing: - 1. You can generate a PostScript file (if you type C-u before activating + 1. You can generate a PostScript file (if you type \\[universal-argument] before activating menu) or PostScript temporary file for a directory, a buffer, a region or a major mode, choosing 1-up, 2-up, 4-up or any other n-up printing; after file generation, ghostview is activated using the file generated @@ -3080,7 +3080,7 @@ I. PostScript printing: `pr-ps-utility-alist'. 2. Operate the same way as option 1, but it sends directly the PostScript - code (or put in a file, if you've typed C-u) or it uses ghostscript to + code (or put in a file, if you've typed \\[universal-argument]) or it uses ghostscript to print the PostScript file generated. It depends on option 18, if it's turned on, it uses ghostscript; otherwise, it sends directly to printer. If spooling is on (option 16), the PostScript code is saved @@ -3089,7 +3089,7 @@ I. PostScript printing: Instead of printing each buffer, region or major mode at once, you can save temporarily the PostScript code generated in a buffer and print it later. The option `Despool...' despools the PostScript spooling buffer - directly on a printer. If you type C-u before choosing this option, + directly on a printer. If you type \\[universal-argument] before choosing this option, the PostScript code generated is saved in a file instead of sending it to the printer. To spool the PostScript code generated you need to turn on option 16. This option is enabled if spooling is on (option 16). @@ -4183,7 +4183,8 @@ bottom." (defun pr-help (&rest _ignore) "Help for the printing package." (interactive) - (pr-show-setup pr-help-message "*Printing Help*")) + (pr-show-setup (substitute-command-keys pr-help-message) + "*Printing Help*")) ;;;###autoload @@ -5036,7 +5037,8 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-show-setup (settings buffer-name) (with-output-to-temp-buffer buffer-name - (princ settings) + (with-current-buffer buffer-name + (insert settings)) (help-print-return-message))) diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 9ea1557391b..57750a2b394 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -887,7 +887,7 @@ ;; subsequent use of movement functions, etc. However, it seems that if font ;; lock _is_ enabled, we can always leave it to do the job. (defvar c-awk-old-ByLL 0) -(make-variable-buffer-local 'c-awk-old-Byll) +(make-variable-buffer-local 'c-awk-old-ByLL) ;; Just beyond logical line following the region which is about to be changed. ;; Set in c-awk-record-region-clear-NL and used in c-awk-after-change. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 04f519dd0a5..f867625480c 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -794,15 +794,16 @@ right side of it." `(c-safe (scan-lists ,from ,count ,depth))))) (if limit `(save-restriction - (when ,limit - ,(if (numberp count) - (if (< count 0) - `(narrow-to-region ,limit (point-max)) - `(narrow-to-region (point-min) ,limit)) - `(if (< ,count 0) - (narrow-to-region ,limit (point-max)) - (narrow-to-region (point-min) ,limit)))) - ,res) + (let ((-limit- ,limit)) + (when -limit- + ,(if (numberp count) + (if (< count 0) + `(narrow-to-region -limit- (point-max)) + `(narrow-to-region (point-min) -limit-)) + `(if (< ,count 0) + (narrow-to-region -limit- (point-max)) + (narrow-to-region (point-min) -limit-)))) + ,res)) res))) @@ -2070,8 +2071,8 @@ non-nil, a caret is prepended to invert the set." str)) ;; Leftovers from (X)Emacs 19 compatibility. -(defalias 'c-regexp-opt 'regexp-opt) -(defalias 'c-regexp-opt-depth 'regexp-opt-depth) +(define-obsolete-function-alias 'c-regexp-opt #'regexp-opt "29.1") +(define-obsolete-function-alias 'c-regexp-opt-depth #'regexp-opt-depth "29.1") ;; Figure out what features this Emacs has diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index bc6155dd668..b2d1f15d398 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9459,7 +9459,8 @@ point unchanged and return nil." (defun c-forward-declarator (&optional limit accept-anon) ;; Assuming point is at the start of a declarator, move forward over it, - ;; leaving point at the next token after it (e.g. a ) or a ; or a ,). + ;; leaving point at the next token after it (e.g. a ) or a ; or a ,), or at + ;; end of buffer if there is no such token. ;; ;; Return a list (ID-START ID-END BRACKETS-AFTER-ID GOT-INIT DECORATED), ;; where ID-START and ID-END are the bounds of the declarator's identifier, @@ -9499,44 +9500,44 @@ point unchanged and return nil." ;; of the while. These are, e.g. "*" in "int *foo" or "(" and ;; "*" in "int (*foo) (void)" (Note similar code in ;; `c-forward-decl-or-cast-1'.) - (while - (cond - ((looking-at c-decl-hangon-key) - (c-forward-keyword-clause 1)) - ((and c-opt-cpp-prefix - (looking-at c-noise-macro-with-parens-name-re)) - (c-forward-noise-clause)) - ((and (looking-at c-type-decl-prefix-key) - (if (and (c-major-mode-is 'c++-mode) - (match-beginning 4)) ; Was 3 - 2021-01-01 - ;; If the third submatch matches in C++ then - ;; we're looking at an identifier that's a - ;; prefix only if it specifies a member pointer. - (progn - (setq id-start (point)) - (c-forward-name) - (if (save-match-data - (looking-at "\\(::\\)")) - ;; We only check for a trailing "::" and - ;; let the "*" that should follow be - ;; matched in the next round. - t - ;; It turned out to be the real identifier, - ;; so flag that and stop. - (setq got-identifier t) - nil)) - t)) - (if (save-match-data - (looking-at c-type-decl-operator-prefix-key)) - (setq decorated t)) - (if (eq (char-after) ?\() - (progn - (setq paren-depth (1+ paren-depth)) - (forward-char)) - (goto-char (or (match-end 1) - (match-end 2)))) - (c-forward-syntactic-ws) - t))) + (while + (cond + ((looking-at c-decl-hangon-key) + (c-forward-keyword-clause 1)) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause)) + ((and (looking-at c-type-decl-prefix-key) + (if (and (c-major-mode-is 'c++-mode) + (match-beginning 4)) ; Was 3 - 2021-01-01 + ;; If the third submatch matches in C++ then + ;; we're looking at an identifier that's a + ;; prefix only if it specifies a member pointer. + (progn + (setq id-start (point)) + (c-forward-name) + (if (save-match-data + (looking-at "\\(::\\)")) + ;; We only check for a trailing "::" and + ;; let the "*" that should follow be + ;; matched in the next round. + t + ;; It turned out to be the real identifier, + ;; so flag that and stop. + (setq got-identifier t) + nil)) + t)) + (if (save-match-data + (looking-at c-type-decl-operator-prefix-key)) + (setq decorated t)) + (if (eq (char-after) ?\() + (progn + (setq paren-depth (1+ paren-depth)) + (forward-char)) + (goto-char (or (match-end 1) + (match-end 2)))) + (c-forward-syntactic-ws) + t))) ;; If we haven't passed the identifier already, do it now. (unless got-identifier @@ -9557,7 +9558,8 @@ point unchanged and return nil." (or (= paren-depth 0) (c-safe (goto-char (scan-lists (point) 1 paren-depth)))) - (<= (point) limit) + (or (eq (point) (point-max)) ; No token after identifier. + (< (point) limit)) ;; Skip over any trailing bit, such as "__attribute__". (progn @@ -10571,8 +10573,8 @@ This function might do hidden buffer changes." backup-maybe-typeless (when c-recognize-typeless-decls (or (not got-suffix) - (not (looking-at - c-after-suffixed-type-maybe-decl-key)))))) + (looking-at + c-after-suffixed-type-maybe-decl-key))))) ;; Got an empty paren pair and a preceding type that probably ;; really is the identifier. Shift the type backwards to make ;; the last one the identifier. This is analogous to the diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 2495d21a10f..12bb3d37513 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -940,7 +940,8 @@ casts and declarations are fontified. Used on level 2 and higher." '(c-decl-arg-start c-decl-end c-decl-id-start - c-decl-type-start))) + c-decl-type-start + c-not-decl))) (1- (point)) pos) limit 'c-type))) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 75f1660f221..068b4a65b21 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -403,7 +403,7 @@ The syntax tables aren't stored directly since they're quite large." t (if (c-lang-const c-recognize-<>-arglists) `(lambda () ;(if (c-lang-const c-recognize-<>-arglists) - (let ((table (funcall ,(c-lang-const c-make-mode-syntax-table)))) + (let ((table (funcall ',(c-lang-const c-make-mode-syntax-table)))) (modify-syntax-entry ?\( "." table) (modify-syntax-entry ?\) "." table) (modify-syntax-entry ?\[ "." table) @@ -4278,7 +4278,7 @@ This macro is expanded at compile time to a form tailored for the mode in question, so MODE must be a constant. Therefore MODE is not evaluated and should not be quoted." (declare (debug nil)) - `(funcall ,(c-make-init-lang-vars-fun mode))) + `(funcall #',(c-make-init-lang-vars-fun mode))) (cc-provide 'cc-langs) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 027fd8f42f5..9327dbf7758 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2440,49 +2440,59 @@ with // and /*, not more generic line and block comments." (and (/= new-pos pos) new-pos)))) (defun c-fl-decl-end (pos) - ;; If POS is inside a declarator, return the end of the token that follows - ;; the declarator, otherwise return nil. POS being in a literal does not - ;; count as being in a declarator (on pragmatic grounds). POINT is not - ;; preserved. + ;; If POS is inside a declarator, return the position of the end of the + ;; paren pair that terminates it, or of the end of the token that follows + ;; the declarator, otherwise return nil. If there is no such token, the end + ;; of the last token in the buffer is used. POS being in a literal is now + ;; (2022-07) handled correctly. POINT is not preserved. (goto-char pos) (let ((lit-start (c-literal-start)) (lim (c-determine-limit 1000)) enclosing-attribute pos1) - (unless lit-start - (c-backward-syntactic-ws - lim) - (when (setq enclosing-attribute (c-enclosing-c++-attribute)) - (goto-char (car enclosing-attribute))) ; Only happens in C++ Mode. - (when (setq pos1 (c-on-identifier)) - (goto-char pos1) - (let ((lim (save-excursion - (and (c-beginning-of-macro) - (progn (c-end-of-macro) (point)))))) - (and (c-forward-declarator lim) - (if (eq (char-after) ?\() - (and - (c-go-list-forward nil lim) - (progn (c-forward-syntactic-ws lim) - (not (eobp))) - (progn - (if (looking-at c-symbol-char-key) - ;; Deal with baz (foo((bar)) type var), where - ;; foo((bar)) is not semantically valid. The result - ;; must be after var). - (and - (goto-char pos) - (setq pos1 (c-on-identifier)) - (goto-char pos1) - (progn - (c-backward-syntactic-ws lim) - (eq (char-before) ?\()) - (c-fl-decl-end (1- (point)))) - (c-backward-syntactic-ws lim) - (point)))) - (and (progn (c-forward-syntactic-ws lim) - (not (eobp))) + (if lit-start + (goto-char lit-start)) + (c-backward-syntactic-ws lim) + (when (setq enclosing-attribute (c-enclosing-c++-attribute)) + (goto-char (car enclosing-attribute)) ; Only happens in C++ Mode. + (c-backward-syntactic-ws lim)) + (while (and (> (point) lim) + (memq (char-before) '(?\[ ?\())) + (backward-char) + (c-backward-syntactic-ws lim)) + (when (setq pos1 (c-on-identifier)) + (goto-char pos1) + (let ((lim (save-excursion + (and (c-beginning-of-macro) + (progn (c-end-of-macro) (point)))))) + (and (c-forward-declarator lim) + (if (and (eq (char-after) ?\() + (c-go-list-forward nil lim)) + (and + (progn (c-forward-syntactic-ws lim) + (not (eobp))) + (progn + (if (looking-at c-symbol-char-key) + ;; Deal with baz (foo((bar)) type var), where + ;; foo((bar)) is not semantically valid. The result + ;; must be after var). + (and + (goto-char pos) + (setq pos1 (c-on-identifier)) + (goto-char pos1) + (progn + (c-backward-syntactic-ws lim) + (eq (char-before) ?\()) + (c-fl-decl-end (1- (point)))) (c-backward-syntactic-ws lim) - (point))))))))) + (point)))) + (if (progn (c-forward-syntactic-ws lim) + (not (eobp))) + (c-forward-over-token) + (let ((lit-start (c-literal-start))) + (when lit-start + (goto-char lit-start)) + (c-backward-syntactic-ws))) + (and (>= (point) pos) (point)))))))) (defun c-change-expand-fl-region (_beg _end _old-len) ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 32031d19462..7d7e9265380 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -1186,7 +1186,7 @@ Intended as the value of `indent-line-function'." (skip-syntax-forward "w_") (when (search-backward-regexp cfengine-mode-syntax-functions-regex - (point-at-bol) + (line-beginning-position) t) (match-string 1))))) (and w (assq (intern w) flist)))))) @@ -1285,7 +1285,7 @@ see. Use it by enabling `eldoc-mode'." "Return completions for function name around or before point." (let* ((bounds (save-excursion (let ((p (point))) - (skip-syntax-backward "w_" (point-at-bol)) + (skip-syntax-backward "w_" (line-beginning-position)) (list (point) p)))) (syntax (cfengine3-make-syntax-cache)) (flist (assq 'functions syntax))) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 91c00ad0488..a3995e2969d 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1,6 +1,6 @@ ;;; cperl-mode.el --- Perl code editing commands for Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1985-1987, 1991-2022 Free Software Foundation, Inc. +;; Copyright (C) 1985-2022 Free Software Foundation, Inc. ;; Author: Ilya Zakharevich ;; Bob Olson @@ -28,21 +28,14 @@ ;;; Commentary: -;; This version of the file contains support for the syntax added by -;; the MooseX::Declare CPAN module, as well as Perl 5.10 keyword -;; support. - ;; You can either fine-tune the bells and whistles of this mode or -;; bulk enable them by putting - -;; (setq cperl-hairy t) +;; bulk enable them by putting this in your Init file: -;; in your .emacs file. (Emacs rulers do not consider it politically -;; correct to make whistles enabled by default.) +;; (setq cperl-hairy t) ;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< -;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< -;; `cperl-praise', `cperl-speed'. <<<<<< +;; or as help on variables `cperl-tips', `cperl-praise', <<<<<< +;; `cperl-speed'. <<<<<< ;; ;; Or search for "Short extra-docs" further down in this file for ;; details on how to use `cperl-mode' instead of `perl-mode' and lots @@ -50,19 +43,18 @@ ;; The mode information (on C-h m) provides some customization help. -;; Faces used now: three faces for first-class and second-class keywords +;; Faces used: three faces for first-class and second-class keywords ;; and control flow words, one for each: comments, string, labels, ;; functions definitions and packages, arrays, hashes, and variable -;; definitions. If you do not see all these faces, your font-lock does -;; not define them, so you need to define them manually. +;; definitions. -;; This mode supports font-lock, imenu and mode-compile. In the -;; hairy version font-lock is on, but you should activate imenu -;; yourself (note that mode-compile is not standard yet). Well, you -;; can use imenu from keyboard anyway (M-g i), but it is better -;; to bind it like that: +;; This mode supports imenu. You can use imenu from the keyboard +;; (M-g i), but you might prefer binding it like this: +;; +;; (define-key global-map [M-S-down-mouse-3] #'imenu) -;; (define-key global-map [M-S-down-mouse-3] 'imenu) +;; This version supports the syntax added by the MooseX::Declare CPAN +;; module, as well as Perl 5.10 keyword support. ;;; Code: @@ -886,8 +878,9 @@ In regular expressions (including character classes): (and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1) (setq cperl-del-back-ch (aref cperl-del-back-ch 0))) -(defun cperl-putback-char (c) ; Emacs 19 - (push c unread-command-events)) ; Avoid undefined warning +(defun cperl-putback-char (c) + (declare (obsolete nil "29.1")) + (push c unread-command-events)) (defsubst cperl-put-do-not-fontify (from to &optional post) ;; If POST, do not do it with postponed fontification @@ -1118,8 +1111,7 @@ Unless KEEP, removes the old indentation." (get-text-property (point) 'syntax-type)) '(here-doc pod))] "----" - ["CPerl pretty print (experimental)" cperl-ps-print - (fboundp 'ps-extend-face-list)] + ["CPerl pretty print (experimental)" cperl-ps-print] "----" ["Syntaxify region" cperl-find-pods-heres-region (use-region-p)] @@ -1132,15 +1124,6 @@ Unless KEEP, removes the old indentation." ["Class Hierarchy from TAGS" cperl-tags-hier-init t] ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] ("Tags" - ;; ["Create tags for current file" cperl-etags t] - ;; ["Add tags for current file" (cperl-etags t) t] - ;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] - ;; ["Add tags for Perl files in directory" (cperl-etags t t) t] - ;; ["Create tags for Perl files in (sub)directories" - ;; (cperl-etags nil 'recursive) t] - ;; ["Add tags for Perl files in (sub)directories" - ;; (cperl-etags t 'recursive) t]) - ;; ;;? cperl-write-tags (&optional file erase recurse dir inbuffer) ["Create tags for current file" (cperl-write-tags nil t) t] ["Add tags for current file" (cperl-write-tags) t] ["Create tags for Perl files in directory" @@ -1153,6 +1136,8 @@ Unless KEEP, removes the old indentation." (cperl-write-tags nil nil t t) t])) ("Perl docs" ["Define word at point" imenu-go-find-at-position + ;; This is from imenu-go.el. I can't find it on any ELPA + ;; archive, so I'm not sure if it's still in use or not. (fboundp 'imenu-go-find-at-position)] ["Help on function" cperl-info-on-command t] ["Help on function at point" cperl-info-on-current-command t] @@ -1888,25 +1873,6 @@ or as help on variables `cperl-tips', `cperl-problems', (cperl-make-indent comment-column 1) ; Indent min 1 c))))) -;;(defun cperl-comment-indent-fallback () -;; "Is called if the standard comment-search procedure fails. -;;Point is at start of real comment." -;; (let ((c (current-column)) target cnt prevc) -;; (if (= c comment-column) nil -;; (setq cnt (skip-chars-backward " \t")) -;; (setq target (max (1+ (setq prevc -;; (current-column))) ; Else indent at comment column -;; comment-column)) -;; (if (= c comment-column) nil -;; (delete-backward-char cnt) -;; (while (< prevc target) -;; (insert "\t") -;; (setq prevc (current-column))) -;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column)))) -;; (while (< prevc target) -;; (insert " ") -;; (setq prevc (current-column))))))) - (defun cperl-indent-for-comment () "Substitute for `indent-for-comment' in CPerl." (interactive) @@ -2115,7 +2081,7 @@ Affected by `cperl-electric-parens'." "Insert a construction appropriate after a keyword. Help message may be switched off by setting `cperl-message-electric-keyword' to nil." - (let ((beg (point-at-bol)) + (let ((beg (line-beginning-position)) (dollar (and (eq last-command-event ?$) (eq this-command 'self-insert-command))) (delete (and (memq last-command-event '(?\s ?\n ?\t ?\f)) @@ -2178,7 +2144,7 @@ to nil." (delete-char -1) (delete-char 1)))) (if delete - (cperl-putback-char cperl-del-back-ch)) + (push cperl-del-back-ch unread-command-events)) (if cperl-message-electric-keyword (message "Precede char by C-q to avoid expansion")))))) @@ -2252,13 +2218,13 @@ to nil." (end-of-line) (setq really-delete t))) (if (and delete really-delete) - (cperl-putback-char cperl-del-back-ch)))))) + (push cperl-del-back-ch unread-command-events)))))) (defun cperl-electric-else () "Insert a construction appropriate after a keyword. Help message may be switched off by setting `cperl-message-electric-keyword' to nil." - (let ((beg (point-at-bol))) + (let ((beg (line-beginning-position))) (and (save-excursion (skip-chars-backward "[:alpha:]") (cperl-after-expr-p nil "{;:")) @@ -2289,7 +2255,7 @@ to nil." (cperl-indent-line) (forward-line -1) (cperl-indent-line) - (cperl-putback-char cperl-del-back-ch) + (push cperl-del-back-ch unread-command-events) (setq this-command 'cperl-electric-else) (if cperl-message-electric-keyword (message "Precede char by C-q to avoid expansion")))))) @@ -2298,8 +2264,8 @@ to nil." "Go to end of line, open a new line and indent appropriately. If in POD, insert appropriate lines." (interactive) - (let ((beg (point-at-bol)) - (end (point-at-eol)) + (let ((beg (line-beginning-position)) + (end (line-end-position)) (pos (point)) start over cut res) (if (and ; Check if we need to split: ; i.e., on a boundary and inside "{...}" @@ -2377,8 +2343,8 @@ If in POD, insert appropriate lines." (forward-paragraph -1) (forward-word-strictly 1) (setq pos (point)) - (setq cut (buffer-substring (point) (point-at-eol))) - (delete-char (- (point-at-eol) (point))) + (setq cut (buffer-substring (point) (line-end-position))) + (delete-char (- (line-end-position) (point))) (setq res (expand-abbrev)) (save-excursion (goto-char pos) @@ -2857,7 +2823,7 @@ Will not look before LIM." (point-max)))) ; do not loop if no syntaxification ;; label: (t - (setq colon-line-end (point-at-eol)) + (setq colon-line-end (line-end-position)) (search-forward ":")))) ;; We are at beginning of code (NOT label or comment) ;; First, the following code counts @@ -2900,7 +2866,7 @@ Will not look before LIM." (looking-at (concat cperl-sub-regexp "\\>")))) (setq p (nth 1 ; start of innermost containing list (parse-partial-sexp - (point-at-bol) + (line-beginning-position) (point))))) (progn (goto-char (1+ p)) ; enclosing block on the same line @@ -3143,7 +3109,7 @@ comment." Returns true if comment is found. In POD will not move the point." ;; If the line is inside other syntax groups (qq-style strings, HERE-docs) ;; then looks for literal # or end-of-line. - (let (state stop-in cpoint (lim (point-at-eol)) pr e) + (let (state stop-in cpoint (lim (line-end-position)) pr e) (or cperl-font-locking (cperl-update-syntaxification lim)) (beginning-of-line) @@ -4054,7 +4020,8 @@ recursive calls in starting lines of here-documents." "") tb (match-beginning 0)) (setq argument nil) - (put-text-property (point-at-bol) b 'first-format-line 't) + (put-text-property (line-beginning-position) + b 'first-format-line 't) (if cperl-pod-here-fontify (while (and (eq (forward-line) 0) (not (looking-at "^[.;]$"))) @@ -5030,7 +4997,7 @@ If `cperl-indent-region-fix-constructs', will improve spacing on conditional/loop constructs." (interactive) (save-excursion - (let ((tmp-end (point-at-eol)) top done) + (let ((tmp-end (line-end-position)) top done) (save-excursion (beginning-of-line) (while (null done) @@ -5080,9 +5047,9 @@ conditional/loop constructs." "\\<\\(else\\|elsif\\|continue\\)\\>")) (progn (goto-char (match-end 0)) - (setq tmp-end (point-at-eol))) + (setq tmp-end (line-end-position))) (setq done t)))) - (setq tmp-end (point-at-eol))) + (setq tmp-end (line-end-position))) (goto-char tmp-end) (setq tmp-end (point-marker))) (if cperl-indent-region-fix-constructs @@ -5095,7 +5062,7 @@ Returns some position at the last line." (interactive) (or end (setq end (point-max))) - (let ((ee (point-at-eol)) + (let ((ee (line-end-position)) (cperl-indent-region-fix-constructs (or cperl-indent-region-fix-constructs 1)) p pp ml have-brace ret) @@ -5271,7 +5238,7 @@ Returns some position at the last line." (if (cperl-indent-line parse-data) (setq ret (cperl-fix-line-spacing end parse-data))))))))))) (beginning-of-line) - (setq p (point) pp (point-at-eol)) ; May be different from ee. + (setq p (point) pp (line-end-position)) ; May be different from ee. ;; Now check whether there is a hanging `}' ;; Looking at: ;; } blah @@ -6030,7 +5997,7 @@ default function." cperl-font-lock-keywords-2 (append t-font-lock-keywords-1 cperl-font-lock-keywords-1))) - (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) + (cperl-ps-print-init) (setq cperl-faces-init t)) (error (message "cperl-init-faces (ignored): %s" errs)))) @@ -7156,13 +7123,6 @@ One may build such TAGS files from CPerl mode menu." (sort root-packages (default-value 'imenu-sort-function))) root-packages)))) -;;(x-popup-menu t -;; '(keymap "Name1" -;; ("Ret1" "aa") -;; ("Head1" "ab" -;; keymap "Name2" -;; ("Tail1" "x") ("Tail2" "y")))) - (defun cperl-list-fold (list name limit) (let (list1 list2 elt1 (num 0)) (if (<= (length list) limit) list @@ -7323,7 +7283,7 @@ Currently it is tuned to C and Perl syntax." ;; Get to the something meaningful (or (eobp) (eolp) (forward-char 1)) (re-search-backward "[-[:alnum:]_:!&*+,./<=>?\\^|~$%@]" - (point-at-bol) + (line-beginning-position) 'to-beg) ;; (cond ;; ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol @@ -8575,8 +8535,8 @@ POS defaults to the point." (let ((p (cperl-get-here-doc-region pos))) (or p (error "Not inside a HERE document")) (narrow-to-region (car p) (cdr p)) - (message - "When you are finished with narrow editing, type C-x n w"))) + (message (substitute-command-keys + "When you are finished with narrow editing, type \\[widen]")))) (defun cperl-select-this-pod-or-here-doc (&optional pos) "Select the HERE-DOC (or POD section) at POS. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 0c4a9bfdbea..4ada27a1aca 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -383,7 +383,9 @@ be used instead. (setq sexp nil)) (`(lambda ,args . ,body) (elisp--local-variables-1 - (append (remq '&optional (remq '&rest args)) vars) + (let ((args (if (listp args) args))) + ;; FIXME: Exit the loop if witness is in args. + (append (remq '&optional (remq '&rest args)) vars)) (car (last body)))) (`(condition-case ,_ ,e) (elisp--local-variables-1 vars e)) (`(condition-case ,v ,_ . ,catches) @@ -1644,6 +1646,7 @@ Return the result of evaluation." ;; printing, not while evaluating. (defvar elisp--eval-defun-result) (let ((debug-on-error eval-expression-debug-on-error) + (edebugging edebug-all-defs) elisp--eval-defun-result) (save-excursion ;; Arrange for eval-region to "read" the (possibly) altered form. @@ -1668,8 +1671,9 @@ Return the result of evaluation." (elisp--eval-defun-1 (macroexpand form))))) (print-length eval-expression-print-length) - (print-level eval-expression-print-level)) - (eval-region beg end standard-output + (print-level eval-expression-print-level) + (should-print (if (not edebugging) standard-output))) + (eval-region beg end should-print (lambda (_ignore) ;; Skipping to the end of the specified region ;; will make eval-region return. @@ -1899,7 +1903,7 @@ or elsewhere, return a 1-line docstring." ;; go to the arg after `&rest'. (if (and key-have-value (save-excursion - (not (re-search-forward ":.*" (point-at-eol) t))) + (not (re-search-forward ":.*" (line-end-position) t))) (string-match "&rest \\([^ ()]*\\)" args)) (setq index nil ; Skip next block based on positional args. start (match-beginning 1) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 7766694edff..db2c8efbd40 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1144,7 +1144,7 @@ error message." ;; Naive match found. Qualify the match. (and (funcall (car order) pattern) ;; Make sure it is not a previous qualified match. - (not (member (set-marker match-marker (point-at-bol)) + (not (member (set-marker match-marker (line-beginning-position)) tag-lines-already-matched)) (throw 'qualified-match-found nil)) (if next-line-after-failure-p @@ -1314,11 +1314,11 @@ buffer-local values of tags table format variables." ;; Find the end of the tag and record the whole tag text. (search-forward "\177") - (setq tag-text (buffer-substring (1- (point)) (point-at-bol))) + (setq tag-text (buffer-substring (1- (point)) (line-beginning-position))) ;; If use-explicit is non-nil and explicit tag is present, use it as part of ;; return value. Else just skip it. (setq explicit-start (point)) - (when (and (search-forward "\001" (point-at-bol 2) t) + (when (and (search-forward "\001" (line-beginning-position 2) t) use-explicit) (setq tag-text (buffer-substring explicit-start (1- (point))))) @@ -1705,7 +1705,7 @@ Point should be just after a string that matches TAG." ;;;###autoload (defalias 'next-file 'tags-next-file) (make-obsolete 'next-file - "use tags-next-file or fileloop-initialize and fileloop-next-file instead" "27.1") + "use `tags-next-file' or `fileloop-initialize' and `fileloop-next-file' instead" "27.1") ;;;###autoload (defun tags-next-file (&optional initialize novisit) "Select next file among files in current tags table. diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index c256198b3c1..bab80719dbd 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -2943,8 +2943,7 @@ Return position where LINE begins." start-posn))) (defun gdb-pad-string (string padding) - (declare (obsolete string-pad "29.1")) - (string-pad string padding nil t)) + (string-pad string (abs padding) nil (natnump padding))) ;; gdb-table struct is a way to programmatically construct simple ;; tables. It help to reliably align columns of data in GDB buffers @@ -2962,8 +2961,7 @@ When non-nil, PROPERTIES will be added to the whole row when calling `gdb-table-string'." (let ((rows (gdb-table-rows table)) (row-properties (gdb-table-row-properties table)) - (column-sizes (gdb-table-column-sizes table)) - (right-align (gdb-table-right-align table))) + (column-sizes (gdb-table-column-sizes table))) (when (not column-sizes) (setf (gdb-table-column-sizes table) (make-list (length row) 0))) @@ -2973,9 +2971,7 @@ calling `gdb-table-string'." (append row-properties (list properties))) (setf (gdb-table-column-sizes table) (cl-mapcar (lambda (x s) - (let ((new-x - (max (abs x) (string-width (or s ""))))) - (if right-align new-x (- new-x)))) + (max (abs x) (string-width (or s "")))) (gdb-table-column-sizes table) row)) ;; Avoid trailing whitespace at eol @@ -2991,7 +2987,10 @@ calling `gdb-table-string'." (lambda (row properties) (apply #'propertize (mapconcat #'identity - (cl-mapcar (lambda (s x) (string-pad s x nil t)) + (cl-mapcar (lambda (s x) + (string-pad + s x nil + (not (gdb-table-right-align table)))) row column-sizes) sep) properties)) diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index f760ccf3686..c7b05873369 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -243,7 +243,8 @@ CATEGORY is the overlay category. If it is nil, use the `glasses' category." (when glasses-separate-parentheses-p (goto-char beg) (while (re-search-forward "[a-zA-Z]_*\\((\\)" end t) - (unless (glasses-parenthesis-exception-p (point-at-bol) (match-end 1)) + (unless (glasses-parenthesis-exception-p (line-beginning-position) + (match-end 1)) (glasses-make-overlay (match-beginning 1) (match-end 1) 'glasses-parenthesis)))))))) @@ -282,7 +283,8 @@ recognized according to the current value of the variable `glasses-separator'." (when glasses-separate-parentheses-p (goto-char (point-min)) (while (re-search-forward "[a-zA-Z]_*\\( \\)(" nil t) - (unless (glasses-parenthesis-exception-p (point-at-bol) (1+ (match-end 1))) + (unless (glasses-parenthesis-exception-p (line-beginning-position) + (1+ (match-end 1))) (replace-match "" t nil nil 1))))))) ;; nil must be returned to allow use in write file hooks nil) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 4c1f801980a..2446e86abbe 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -126,11 +126,22 @@ include it when specifying `grep-command'. In interactive usage, the actual value of this variable is set up by `grep-compute-defaults'; to change the default value, use -\\[customize] or call the function `grep-apply-setting'." +\\[customize] or call the function `grep-apply-setting'. + +Also see `grep-command-position'." :type '(choice string (const :tag "Not Set" nil)) :set #'grep-apply-setting) +(defcustom grep-command-position nil + "Where to put point when prompting for a grep command. +This controls the placement of point in the minibuffer when Emacs +prompts for the grep command. If nil, put point at the end of +the suggested command. If non-nil, this should be the one-based +position in the minibuffer where to place point." + :type '(choice (const :tag "At the end" nil) + natnum)) + (defcustom grep-template nil "The default command to run for \\[lgrep]. The following place holders should be present in the string: @@ -931,10 +942,15 @@ list is empty)." (progn (grep-compute-defaults) (let ((default (grep-default-command))) - (list (read-shell-command "Run grep (like this): " - (if current-prefix-arg default grep-command) - 'grep-history - (if current-prefix-arg nil default)))))) + (list (read-shell-command + "Run grep (like this): " + (if current-prefix-arg + default + (if grep-command-position + (cons grep-command grep-command-position) + grep-command)) + 'grep-history + (if current-prefix-arg nil default)))))) ;; If called non-interactively, also compute the defaults if we ;; haven't already. (when (eq grep-highlight-matches 'auto-detect) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index f574ec84fbe..c0796fc2eeb 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -267,7 +267,9 @@ This has effect only if `search-invisible' is set to `open'." )) "Alist for initializing the hideshow variables for different modes. Each element has the form - (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). + (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC + FIND-BLOCK-BEGINNING-FUNC FIND-NEXT-BLOCK-FUNC + LOOKING-AT-BLOCK-START-P-FUNC). If non-nil, hideshow will use these values as regexps to define blocks and comments, respectively for major mode MODE. @@ -288,6 +290,15 @@ cases, FORWARD-SEXP-FUNC specifies another function to use instead. See the documentation for `hs-adjust-block-beginning' to see what is the use of ADJUST-BEG-FUNC. +See the documentation for `hs-find-block-beginning-func' to see +what is the use of FIND-BLOCK-BEGINNING-FUNC. + +See the documentation for `hs-find-next-block-func' to see what +is the use of FIND-NEXT-BLOCK-FUNC. + +See the documentation for `hs-looking-at-block-start-p-func' to +see what is the use of LOOKING-AT-BLOCK-START-P-FUNC. + If any of the elements is left nil or omitted, hideshow tries to guess appropriate values. The regexps should not contain leading or trailing whitespace. Case does not matter.") @@ -433,6 +444,39 @@ It should not move the point. See `hs-c-like-adjust-block-beginning' for an example of using this.") +(defvar-local hs-find-block-beginning-func #'hs-find-block-beginning + "Function used to do `hs-find-block-beginning'. +It should reposition point at the beginning of the current block +and return point, or nil if original point was not in a block. + +Specifying this function is necessary for languages such as +Python, where regexp search and `syntax-ppss' check is not enough +to find the beginning of the current block.") + +(defvar-local hs-find-next-block-func #'hs-find-next-block + "Function used to do `hs-find-next-block'. +It should reposition point at next block start. + +It is called with three arguments REGEXP, MAXP, and COMMENTS. +REGEXP is a regexp representing block start. When block start is +found, `match-data' should be set using REGEXP. MAXP is a buffer +position that bounds the search. When COMMENTS is nil, comments +should be skipped. When COMMENTS is not nil, REGEXP matches not +only beginning of a block but also beginning of a comment. In +this case, the function should find nearest block or comment. + +Specifying this function is necessary for languages such as +Python, where regexp search is not enough to find the beginning +of the next block.") + +(defvar-local hs-looking-at-block-start-p-func #'hs-looking-at-block-start-p + "Function used to do `hs-looking-at-block-start-p'. +It should return non-nil if the point is at the block start. + +Specifying this function is necessary for languages such as +Python, where `looking-at' and `syntax-ppss' check is not enough +to check if the point is at the block start.") + (defvar hs-headline nil "Text of the line where a hidden block begins, set during isearch. You can display this in the mode line by adding the symbol `hs-headline' @@ -565,7 +609,7 @@ The block beginning is adjusted by `hs-adjust-block-beginning' and then further adjusted to be at the end of the line." (if comment-reg (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) - (when (hs-looking-at-block-start-p) + (when (funcall hs-looking-at-block-start-p-func) (let ((mdata (match-data t)) (header-end (match-end 0)) p q ov) @@ -672,7 +716,14 @@ function; and adjust-block-beginning function." 0 (1- (match-end 0))) c-start-regexp))) hs-forward-sexp-func (or (nth 4 lookup) #'forward-sexp) - hs-adjust-block-beginning (or (nth 5 lookup) #'identity))) + hs-adjust-block-beginning (or (nth 5 lookup) #'identity) + hs-find-block-beginning-func (or (nth 6 lookup) + #'hs-find-block-beginning) + hs-find-next-block-func (or (nth 7 lookup) + #'hs-find-next-block) + hs-looking-at-block-start-p-func + (or (nth 8 lookup) + #'hs-looking-at-block-start-p))) (setq hs-minor-mode nil) (error "%s Mode doesn't support Hideshow Minor Mode" (format-mode-line mode-name)))) @@ -683,7 +734,7 @@ Return point, or nil if original point was not in a block." (let ((done nil) (here (point))) ;; look if current line is block start - (if (hs-looking-at-block-start-p) + (if (funcall hs-looking-at-block-start-p-func) (point) ;; look backward for the start of a block that contains the cursor (while (and (re-search-backward hs-block-start-regexp nil t) @@ -698,19 +749,25 @@ Return point, or nil if original point was not in a block." (goto-char here) nil)))) +(defun hs-find-next-block (regexp maxp comments) + "Reposition point at next block-start. +Skip comments if COMMENTS is nil, and search for REGEXP in +region (point MAXP)." + (when (not comments) + (forward-comment (point-max))) + (and (< (point) maxp) + (re-search-forward regexp maxp t))) + (defun hs-hide-level-recursive (arg minp maxp) "Recursively hide blocks ARG levels below point in region (MINP MAXP)." - (when (hs-find-block-beginning) + (when (funcall hs-find-block-beginning-func) (setq minp (1+ (point))) (funcall hs-forward-sexp-func 1) (setq maxp (1- (point)))) (unless hs-allow-nesting (hs-discard-overlays minp maxp)) (goto-char minp) - (while (progn - (forward-comment (buffer-size)) - (and (< (point) maxp) - (re-search-forward hs-block-start-regexp maxp t))) + (while (funcall hs-find-next-block-func hs-block-start-regexp maxp nil) (when (save-match-data (not (nth 8 (syntax-ppss)))) ; not inside comments or strings (if (> arg 1) @@ -747,8 +804,8 @@ and `case-fold-search' are both t." (goto-char (nth 0 c-reg)) (end-of-line) (when (and (not c-reg) - (hs-find-block-beginning) - (hs-looking-at-block-start-p)) + (funcall hs-find-block-beginning-func) + (funcall hs-looking-at-block-start-p-func)) ;; point is inside a block (goto-char (match-end 0))))) (end-of-line) @@ -790,10 +847,8 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." hs-c-start-regexp "\\)") "")))) - (while (progn - (unless hs-hide-comments-when-hiding-all - (forward-comment (point-max))) - (re-search-forward re (point-max) t)) + (while (funcall hs-find-next-block-func re (point-max) + hs-hide-comments-when-hiding-all) (if (match-beginning 1) ;; We have found a block beginning. (progn @@ -838,8 +893,8 @@ Upon completion, point is repositioned and the normal hook (<= (count-lines (car c-reg) (nth 1 c-reg)) 1))) (message "(not enough comment lines to hide)")) ((or c-reg - (hs-looking-at-block-start-p) - (hs-find-block-beginning)) + (funcall hs-looking-at-block-start-p-func) + (funcall hs-find-block-beginning-func)) (hs-hide-block-at-point end c-reg) (run-hooks 'hs-hide-hook)))))) @@ -868,9 +923,9 @@ See documentation for functions `hs-hide-block' and `run-hooks'." (when (car c-reg) (setq p (car c-reg) q (cadr c-reg)))) - ((and (hs-find-block-beginning) + ((and (funcall hs-find-block-beginning-func) ;; ugh, fresh match-data - (hs-looking-at-block-start-p)) + (funcall hs-looking-at-block-start-p-func)) (setq p (point) q (progn (hs-forward-sexp (match-data t) 1) (point))))) (when (and p q) diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index ec281f3a496..2da0fb16773 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -163,8 +163,6 @@ with no args, if that value is non-nil." '((icon-font-lock-keywords icon-font-lock-keywords-1 icon-font-lock-keywords-2) nil nil ((?_ . "w")) beginning-of-defun - ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP. - ;;(font-lock-comment-start-regexp . "#") (font-lock-mark-block-function . mark-defun))) ;; imenu support (setq-local imenu-generic-expression icon-imenu-generic-expression) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index d21a9faec9d..63f032b7b39 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1381,7 +1381,7 @@ Otherwise just move the line. Move down unless UP is non-nil." (arg (if up arg (- arg)))) (if (eq t idlwave-shell-arrows-do-history) (goto-char proc-pos)) (if (and idlwave-shell-arrows-do-history - (>= (1+ (point-at-eol)) proc-pos)) + (>= (1+ (line-end-position)) proc-pos)) (comint-previous-input arg) (forward-line (- arg))))) @@ -2130,7 +2130,7 @@ args of an executive .run, .rnew or .compile." (defun idlwave-shell-filename-string () "Return t if in a string and after what could be a file name." - (let ((limit (point-at-bol))) + (let ((limit (line-beginning-position))) (save-excursion ;; Skip backwards over file name chars (skip-chars-backward idlwave-shell-file-name-chars limit) @@ -2139,7 +2139,7 @@ args of an executive .run, .rnew or .compile." (defun idlwave-shell-batch-command () "Return t if we're in a batch command statement like \"@foo\"." - (let ((limit (point-at-bol))) + (let ((limit (line-beginning-position))) (save-excursion ;; Skip backwards over filename (skip-chars-backward idlwave-shell-file-name-chars limit) @@ -2317,7 +2317,7 @@ matter what the settings of that variable." idlwave-shell-electric-stop-line-face idlwave-shell-stop-line-face)) (move-overlay idlwave-shell-stop-line-overlay - (point) (point-at-eol) + (point) (line-end-position) (current-buffer))) ;; use the arrow instead, but only if marking is wanted. (if idlwave-shell-mark-stop-line @@ -2510,7 +2510,7 @@ If in the IDL shell buffer, returns `idlwave-shell-pc-frame'." (list (idlwave-shell-file-name (buffer-file-name)) (save-restriction (widen) - (1+ (count-lines 1 (point-at-bol))))))) + (1+ (count-lines 1 (line-beginning-position))))))) (defun idlwave-shell-current-module () "Return the name of the module for the current file. @@ -3528,7 +3528,7 @@ Existing overlays are recycled, in order to minimize consumption." (while (setq bp (pop bp-list)) (save-excursion (idlwave-shell-goto-frame (car bp)) - (let* ((end (point-at-eol)) + (let* ((end (line-end-position)) (beg (progn (beginning-of-line 1) (point))) (condition (idlwave-shell-bp-get bp 'condition)) (count (idlwave-shell-bp-get bp 'count)) @@ -3851,7 +3851,7 @@ of the form: (append ;; compiled procedures (progn - (narrow-to-region cpro (point-at-bol)) + (narrow-to-region cpro (line-beginning-position)) (goto-char (point-min)) (idlwave-shell-sources-grep)) ;; compiled functions diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index b290854e1b9..81f74dc1fa1 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -2004,7 +2004,7 @@ Returns non-nil if abbrev is left expanded." Moves to end of line if there is no comment delimiter. Ignores comment delimiters in strings. Returns point if comment found and nil otherwise." - (let ((eos (point-at-eol)) + (let ((eos (line-end-position)) (data (match-data)) found) ;; Look for first comment delimiter not in a string @@ -2054,7 +2054,7 @@ Also checks if the correct END statement has been used." ;;(backward-char 1) (let* ((pos (point-marker)) (last-abbrev-marker (copy-marker last-abbrev-location)) - (eol-pos (point-at-eol)) + (eol-pos (line-end-position)) begin-pos end-pos end end1 ) (if idlwave-reindent-end (idlwave-indent-line)) (setq last-abbrev-location (marker-position last-abbrev-marker)) @@ -3202,7 +3202,7 @@ ignored." (beginning-of-line) (setq bcl (point)) (re-search-forward (concat "^[ \t]*" comment-start "+") - (point-at-eol) t) + (line-end-position) t) ;; Get the comment leader on the line and its length (setq pre (current-column)) ;; the comment leader is the indentation plus exactly the @@ -3210,7 +3210,8 @@ ignored." (setq fill-prefix-reg (concat (setq fill-prefix - (regexp-quote (buffer-substring (point-at-bol) (point)))) + (regexp-quote (buffer-substring (line-beginning-position) + (point)))) "[^;]")) ;; Mark the beginning and end of the paragraph @@ -3264,7 +3265,7 @@ ignored." (setq indent hang) (beginning-of-line) (while (> (point) start) - (re-search-forward comment-start-skip (point-at-eol) t) + (re-search-forward comment-start-skip (line-end-position) t) (if (> (setq diff (- indent (current-column))) 0) (progn (if (>= here (point)) @@ -3286,7 +3287,7 @@ ignored." (setq indent (min indent (progn - (re-search-forward comment-start-skip (point-at-eol) t) + (re-search-forward comment-start-skip (line-end-position) t) (current-column)))) (forward-line -1))) (setq fill-prefix (concat fill-prefix @@ -3296,7 +3297,7 @@ ignored." (setq first-indent (max (progn - (re-search-forward comment-start-skip (point-at-eol) t) + (re-search-forward comment-start-skip (line-end-position) t) (current-column)) indent)) @@ -3334,11 +3335,11 @@ If not found returns nil." (if idlwave-use-last-hang-indent (save-excursion (end-of-line) - (if (re-search-backward idlwave-hang-indent-regexp (point-at-bol) t) + (if (re-search-backward idlwave-hang-indent-regexp (line-beginning-position) t) (+ (current-column) (length idlwave-hang-indent-regexp)))) (save-excursion (beginning-of-line) - (if (re-search-forward idlwave-hang-indent-regexp (point-at-eol) t) + (if (re-search-forward idlwave-hang-indent-regexp (line-end-position) t) (current-column))))) (defun idlwave-auto-fill () @@ -3386,7 +3387,7 @@ if `idlwave-auto-fill-split-string' is non-nil." ;; Remove whitespace between comment delimiter and ;; text, insert spaces for appropriate indentation. (beginning-of-line) - (re-search-forward comment-start-skip (point-at-eol) t) + (re-search-forward comment-start-skip (line-end-position) t) (delete-horizontal-space) (idlwave-indent-to indent) (goto-char (- (point-max) here))))) @@ -3548,7 +3549,7 @@ constants - a double quote followed by an octal digit." ;; Because single and double quotes can quote each other we must ;; search for the string start from the beginning of line. (let* ((start (point)) - (eol (point-at-eol)) + (eol (line-end-position)) (bq (progn (beginning-of-line) (point))) (endq (point)) (data (match-data)) @@ -3626,7 +3627,7 @@ unless the optional second argument NOINDENT is non-nil." (setq s1 (downcase s1) s2 (downcase s2))) (idlwave-abbrev-change-case (setq s1 (upcase s1) s2 (upcase s2)))) - (let ((beg (point-at-bol)) + (let ((beg (line-beginning-position)) end) (if (not (looking-at "\\s-*\n")) (open-line 1)) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index efad3b52aa9..b920ef6c2cc 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -812,7 +812,7 @@ point at BOB." (setq str-terminator ?/)) (re-search-forward (concat "\\([^\\]\\|^\\)" (string str-terminator)) - (point-at-eol) t)) + (line-end-position) t)) ((nth 7 parse) (forward-line)) ((or (nth 4 parse) @@ -1683,7 +1683,7 @@ point of view of font-lock. It applies highlighting directly with (insert "=") (goto-char (match-beginning 2))) (setq js--tmp-location nil) - (goto-char (point-at-eol))) + (goto-char (line-end-position))) (when js--tmp-location (save-excursion (goto-char js--tmp-location) @@ -2506,14 +2506,14 @@ the same column as the current line." (looking-at "[ \t\n]*}")) (save-excursion (backward-list) (forward-symbol -1) (looking-at "\\_<do\\_>")) - (js--re-search-backward "\\_<do\\_>" (point-at-bol) t) + (js--re-search-backward "\\_<do\\_>" (line-beginning-position) t) (or (looking-at "\\_<do\\_>") (let ((saved-indent (current-indentation))) (while (and (js--re-search-backward "^\\s-*\\_<" nil t) (/= (current-indentation) saved-indent))) (and (looking-at "\\s-*\\_<do\\_>") (not (js--re-search-forward - "\\_<while\\_>" (point-at-eol) t)) + "\\_<while\\_>" (line-end-position) t)) (= (current-indentation) saved-indent))))))))) @@ -2525,7 +2525,7 @@ nil." (save-excursion (back-to-indentation) (when (save-excursion - (and (not (eq (point-at-bol) (point-min))) + (and (not (eq (line-beginning-position) (point-min))) (not (looking-at "[{]")) (js--re-search-backward "[[:graph:]]" nil t) (progn @@ -2546,8 +2546,8 @@ nil." (c-get-syntactic-indentation (list (cons symbol anchor))))) (defun js--same-line (pos) - (and (>= pos (point-at-bol)) - (<= pos (point-at-eol)))) + (and (>= pos (line-beginning-position)) + (<= pos (line-end-position)))) (defun js--multi-line-declaration-indentation () "Helper function for `js--proper-indentation'. @@ -2921,7 +2921,7 @@ return nil." "Indent the current line as JavaScript." (interactive) (let* ((parse-status - (save-excursion (syntax-ppss (point-at-bol)))) + (save-excursion (syntax-ppss (line-beginning-position)))) (offset (- (point) (save-excursion (back-to-indentation) (point))))) (unless (nth 3 parse-status) (indent-line-to (js--proper-indentation parse-status)) diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 30d37cf7ecd..00bab00a0d4 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -520,7 +520,7 @@ If the list was changed, sort the list and remove duplicates first." (looking-at meta-ignore-comment-regexp)) (current-indentation)) ;; Beginning of buffer. - ((eq (point-at-bol) (point-min)) + ((eq (line-beginning-position) (point-min)) 0) ;; Backindent at end of environments. ((meta-indent-looking-at-code @@ -558,14 +558,14 @@ If the list was changed, sort the list and remove duplicates first." (end-of-line) ;; Skip backward the comments. (let ((point-not-in-string (point))) - (while (search-backward comment-start (point-at-bol) t) + (while (search-backward comment-start (line-beginning-position) t) (unless (meta-indent-in-string-p) (setq point-not-in-string (point)))) (goto-char point-not-in-string)) ;; Search for the end of the previous expression. - (if (search-backward ";" (point-at-bol) t) + (if (search-backward ";" (line-beginning-position) t) (progn (while (and (meta-indent-in-string-p) - (search-backward ";" (point-at-bol) t))) + (search-backward ";" (line-beginning-position) t))) (if (= (char-after) ?\;) (forward-char) (beginning-of-line))) diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 8d3194e6a47..9786b1aa455 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -274,7 +274,7 @@ are handled in another way, and should not be added to this list." (while (and (> nest 0) (re-search-forward "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" - (point-at-eol 2) t)) + (line-end-position 2) t)) (cond ((match-beginning 1) (setq nest (1+ nest))) ((match-beginning 2) (setq nest (1- nest))) ((looking-at "[^(\n]+)") (setq nest 0)))))) @@ -283,7 +283,8 @@ are handled in another way, and should not be added to this list." (defun pascal-declaration-beg () (let ((nest 1)) (while (and (> nest 0) - (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (point-at-bol 0) t)) + (re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" + (line-beginning-position 0) t)) (cond ((match-beginning 1) (setq nest 0)) ((match-beginning 2) (setq nest (1- nest))) ((match-beginning 3) (setq nest (1+ nest))))) @@ -291,7 +292,7 @@ are handled in another way, and should not be added to this list." (defsubst pascal-within-string () - (nth 3 (parse-partial-sexp (point-at-bol) (point)))) + (nth 3 (parse-partial-sexp (line-beginning-position) (point)))) ;;;###autoload @@ -388,7 +389,7 @@ See also the user variables `pascal-type-keywords', `pascal-start-keywords' and (forward-char 1) (delete-horizontal-space)) ((and (looking-at "(\\*\\|\\*[^)]") - (not (save-excursion (search-forward "*)" (point-at-eol) t)))) + (not (save-excursion (search-forward "*)" (line-end-position) t)))) (setq setstar t)))) ;; If last line was a star comment line then this one shall be too. (if (null setstar) @@ -707,7 +708,7 @@ on the line which ends a function or procedure named NAME." (if (and (looking-at "\\<end;") (not (save-excursion (end-of-line) - (search-backward "{" (point-at-bol) t)))) + (search-backward "{" (line-beginning-position) t)))) (let ((type (car (pascal-calculate-indent)))) (if (eq type 'declaration) () @@ -979,7 +980,7 @@ indent of the current line in parameterlist." (stpos (progn (goto-char (scan-lists (point) -1 1)) (point))) (stcol (1+ (current-column))) (edpos (progn (pascal-declaration-end) - (search-backward ")" (point-at-bol) t) + (search-backward ")" (line-beginning-position) t) (point))) (usevar (re-search-backward "\\<var\\>" stpos t))) (if arg (progn @@ -1026,7 +1027,7 @@ indent of the current line in parameterlist." (setq pascal--extra-indent (pascal-get-lineup-indent stpos edpos lineup)) (goto-char stpos) (while (and (<= (point) edpos) (not (eobp))) - (if (search-forward lineup (point-at-eol) 'move) + (if (search-forward lineup (line-end-position) 'move) (forward-char -1)) (delete-horizontal-space) (indent-to pascal--extra-indent) @@ -1053,7 +1054,7 @@ indent of the current line in parameterlist." (goto-char b) ;; Get rightmost position (while (< (point) e) - (and (re-search-forward reg (min e (point-at-eol 2)) 'move) + (and (re-search-forward reg (min e (line-end-position 2)) 'move) (cond ((match-beginning 1) ;; Skip record blocks (pascal-declaration-end)) @@ -1117,7 +1118,7 @@ indent of the current line in parameterlist." ;; Search through all reachable functions (while (pascal-beg-of-defun) - (if (re-search-forward pascal-str (point-at-eol) t) + (if (re-search-forward pascal-str (line-end-position) t) (progn (setq match (buffer-substring (match-beginning 2) (match-end 2))) (push match pascal-all))) @@ -1134,17 +1135,17 @@ indent of the current line in parameterlist." match) ;; Traverse lines (while (< (point) end) - (if (re-search-forward "[:=]" (point-at-eol) t) + (if (re-search-forward "[:=]" (line-end-position) t) ;; Traverse current line (while (and (re-search-backward (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" pascal-symbol-re) - (point-at-bol) t) + (line-beginning-position) t) (not (match-end 1))) (setq match (buffer-substring (match-beginning 0) (match-end 0))) (if (string-match (concat "\\<" pascal-str) match) (push match pascal-all)))) - (if (re-search-forward "\\<record\\>" (point-at-eol) t) + (if (re-search-forward "\\<record\\>" (line-end-position) t) (pascal-declaration-end) (forward-line 1))) @@ -1187,7 +1188,7 @@ indent of the current line in parameterlist." (if (> start (prog1 (save-excursion (pascal-end-of-defun) (point)))) () ; Declarations not reachable - (if (search-forward "(" (point-at-eol) t) + (if (search-forward "(" (line-end-position) t) ;; Check parameterlist ;; FIXME: pascal-get-completion-decl doesn't understand ;; the var declarations in parameter lists :-( @@ -1245,7 +1246,7 @@ indent of the current line in parameterlist." (or (eq state 'declaration) (eq state 'paramlist) (and (eq state 'defun) (save-excursion - (re-search-backward ")[ \t]*:" (point-at-bol) t)))) + (re-search-backward ")[ \t]*:" (line-beginning-position) t)))) (save-excursion (if (or (eq state 'paramlist) (eq state 'defun)) (pascal-beg-of-defun)) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 6437bbd4c1c..f8edc2b1f7b 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -2282,12 +2282,12 @@ between them)." (backward-paragraph) (unless (bobp) (forward-line)) (if (string-match "^/\\*[^a-zA-Z]*$" (thing-at-point 'line)) - (narrow-to-region (point-at-eol) (point-max)))) + (narrow-to-region (line-end-position) (point-max)))) (save-excursion (forward-paragraph) (forward-line -1) (if (string-match "^[^a-zA-Z]*\\*/$" (thing-at-point 'line)) - (narrow-to-region (point-min) (point-at-bol)))) + (narrow-to-region (point-min) (line-beginning-position)))) (let ((fill-prefix (prolog-guess-fill-prefix))) (fill-paragraph nil)))) ))) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 44df3186b27..d3ffc2db2c9 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -359,6 +359,7 @@ "Python mode specialized rx macro. This variant of `rx' supports common Python named REGEXPS." `(rx-let ((sp-bsnl (or space (and ?\\ ?\n))) + (sp-nl (or space (and (? ?\\) ?\n))) (block-start (seq symbol-start (or "def" "class" "if" "elif" "else" "try" "except" "finally" "for" "while" "with" @@ -583,9 +584,9 @@ the {...} holes that appear within f-strings." finally return (and result-valid result)))) (defvar python-font-lock-keywords-level-1 - `((,(python-rx symbol-start "def" (1+ space) (group symbol-name)) + `((,(python-rx symbol-start "def" (1+ sp-bsnl) (group symbol-name)) (1 font-lock-function-name-face)) - (,(python-rx symbol-start "class" (1+ space) (group symbol-name)) + (,(python-rx symbol-start "class" (1+ sp-bsnl) (group symbol-name)) (1 font-lock-type-face))) "Font lock keywords to use in `python-mode' for level 1 decoration. @@ -725,12 +726,12 @@ sign in chained assignment." ;; [*a] = 5, 6 ;; are handled separately below (,(python-font-lock-assignment-matcher - (python-rx (? (or "[" "(") (* space)) - grouped-assignment-target (* space) ?, (* space) - (* assignment-target (* space) ?, (* space)) - (? assignment-target (* space)) - (? ?, (* space)) - (? (or ")" "]") (* space)) + (python-rx (? (or "[" "(") (* sp-nl)) + grouped-assignment-target (* sp-nl) ?, (* sp-nl) + (* assignment-target (* sp-nl) ?, (* sp-nl)) + (? assignment-target (* sp-nl)) + (? ?, (* sp-nl)) + (? (or ")" "]") (* sp-bsnl)) (group assignment-operator))) (1 font-lock-variable-name-face) (,(python-rx grouped-assignment-target) @@ -745,19 +746,20 @@ sign in chained assignment." ;; c: Collection = {1, 2, 3} ;; d: Mapping[int, str] = {1: 'bar', 2: 'baz'} (,(python-font-lock-assignment-matcher - (python-rx grouped-assignment-target (* space) - (? ?: (* space) (+ not-simple-operator) (* space)) - assignment-operator)) + (python-rx (or line-start ?\;) (* sp-bsnl) + grouped-assignment-target (* sp-bsnl) + (? ?: (* sp-bsnl) (+ not-simple-operator) (* sp-bsnl)) + assignment-operator)) (1 font-lock-variable-name-face)) ;; special cases ;; (a) = 5 ;; [a] = 5, ;; [*a] = 5, 6 (,(python-font-lock-assignment-matcher - (python-rx (or line-start ?\; ?=) (* space) - (or "[" "(") (* space) - grouped-assignment-target (* space) - (or ")" "]") (* space) + (python-rx (or line-start ?\; ?=) (* sp-bsnl) + (or "[" "(") (* sp-nl) + grouped-assignment-target (* sp-nl) + (or ")" "]") (* sp-bsnl) assignment-operator)) (1 font-lock-variable-name-face)) ;; escape sequences within bytes literals @@ -796,6 +798,18 @@ decorators, exceptions, and assignments.") Which one will be chosen depends on the value of `font-lock-maximum-decoration'.") +(defun python-font-lock-extend-region (beg end _old-len) + "Extend font-lock region given by BEG and END to statement boundaries." + (save-excursion + (save-match-data + (goto-char beg) + (python-nav-beginning-of-statement) + (setq beg (point)) + (goto-char end) + (python-nav-end-of-statement) + (setq end (point)) + (cons beg end)))) + (defconst python-syntax-propertize-function (syntax-propertize-rules @@ -1224,8 +1238,14 @@ possibilities can be narrowed to specific indentation points." ;; Add one indentation level. (goto-char start) (+ (current-indentation) python-indent-offset)) + (`(:after-backslash-block-continuation . ,start) + (goto-char start) + (let ((column (current-column))) + (if (= column (+ (current-indentation) python-indent-offset)) + ;; Add one level to avoid same indent as next logical line. + (+ column python-indent-offset) + column))) (`(,(or :inside-paren - :after-backslash-block-continuation :after-backslash-dotted-continuation) . ,start) ;; Use the column given by the context. (goto-char start) @@ -1504,6 +1524,10 @@ marks the next defun after the ones already marked." The name of the defun should be grouped so it can be retrieved via `match-string'.") +(defvar python-nav-beginning-of-block-regexp + (python-rx line-start (* space) block-start) + "Regexp matching block start.") + (defun python-nav--beginning-of-defun (&optional arg) "Internal implementation of `python-nav-beginning-of-defun'. With positive ARG search backwards, else search forwards." @@ -4542,6 +4566,11 @@ the if condition." (not (python-syntax-comment-or-string-p)) python-skeleton-autoinsert))) +(defun python--completion-predicate (_ buffer) + (provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + 'python-mode)) + (defmacro python-skeleton-define (name doc &rest skel) "Define a `python-mode' skeleton using NAME DOC and SKEL. The skeleton will be bound to python-skeleton-NAME and will @@ -4550,6 +4579,7 @@ be added to `python-mode-skeleton-abbrev-table'." (let* ((name (symbol-name name)) (function-name (intern (concat "python-skeleton-" name)))) `(progn + (put ',function-name 'completion-predicate #'python--completion-predicate) (define-abbrev python-mode-skeleton-abbrev-table ,name "" ',function-name :system t) (setq python-skeleton-available @@ -4575,13 +4605,15 @@ The skeleton will be bound to python-skeleton-NAME." (setq skel `(< ,(format "%s:" name) \n \n > _ \n))) - `(define-skeleton ,function-name - ,(or doc - (format "Auxiliary skeleton for %s statement." name)) - nil - (unless (y-or-n-p ,msg) - (signal 'quit t)) - ,@skel))) + `(progn + (put ',function-name 'completion-predicate #'ignore) + (define-skeleton ,function-name + ,(or doc + (format "Auxiliary skeleton for %s statement." name)) + nil + (unless (y-or-n-p ,msg) + (signal 'quit t)) + ,@skel)))) (python-define-auxiliary-skeleton else) @@ -4704,11 +4736,12 @@ def __FFAP_get_module_path(objstr): ;;; Code check (defcustom python-check-command - (or (executable-find "pyflakes") - (executable-find "epylint") - "install pyflakes, pylint or something else") + (cond ((executable-find "pyflakes") "pyflakes") + ((executable-find "epylint") "epylint") + (t "pyflakes")) "Command used to check a Python file." - :type 'string) + :type 'string + :version "29.1") (defcustom python-check-buffer-name "*Python check: %s*" @@ -4887,9 +4920,37 @@ Interactively, prompt for symbol." (defun python-hideshow-forward-sexp-function (_arg) "Python specific `forward-sexp' function for `hs-minor-mode'. Argument ARG is ignored." - (python-nav-end-of-defun) - (unless (python-info-current-line-empty-p) - (backward-char))) + (python-nav-end-of-block)) + +(defun python-hideshow-find-next-block (regexp maxp comments) + "Python specific `hs-find-next-block' function for `hs-minor-mode'. +Call `python-nav-forward-block' to find next block and check if +block-start ends within MAXP. If COMMENTS is not nil, comments +are also searched. REGEXP is passed to `looking-at' to set +`match-data'." + (let* ((next-block (save-excursion + (or (and + (python-info-looking-at-beginning-of-block) + (re-search-forward + (python-rx block-start) maxp t)) + (and (python-nav-forward-block) + (< (point) maxp) + (re-search-forward + (python-rx block-start) maxp t)) + (1+ maxp)))) + (next-comment + (or (when comments + (save-excursion + (cl-loop while (re-search-forward "#" maxp t) + if (python-syntax-context 'comment) + return (point)))) + (1+ maxp))) + (next-block-or-comment (min next-block next-comment))) + (when (<= next-block-or-comment maxp) + (goto-char next-block-or-comment) + (save-excursion + (beginning-of-line) + (looking-at regexp))))) ;;; Imenu @@ -5386,6 +5447,16 @@ instead of the current physical line." (beginning-of-line 1) (looking-at python-nav-beginning-of-defun-regexp)))) +(defun python-info-looking-at-beginning-of-block () + "Check if point is at the beginning of block." + (let ((pos (point))) + (save-excursion + (python-nav-beginning-of-statement) + (beginning-of-line) + (and + (<= (point) pos (+ (point) (current-indentation))) + (looking-at python-nav-beginning-of-block-regexp))))) + (defun python-info-current-line-comment-p () "Return non-nil if current line is a comment line." (char-equal @@ -5627,9 +5698,13 @@ returned as is." This is a non empty list of strings, the checker tool possibly followed by required arguments. Once launched it will receive the Python source to be checked as its standard input. -To use `flake8' you would set this to (\"flake8\" \"-\")." +To use `flake8' you would set this to (\"flake8\" \"-\"). +To use `pylint' you would set this to (\"pylint\" \"--from-stdin\" \"stdin\")." :version "26.1" - :type '(repeat string)) + :type '(choice (const :tag "Pyflakes" ("pyflakes")) + (const :tag "Flake8" ("flake8" "-")) + (const :tag "Pylint" ("pylint" "--from-stdin" "stdin")) + (repeat :tag "Custom command" string))) ;; The default regexp accommodates for older pyflakes, which did not ;; report the column number, and at the same time it's compatible with @@ -5637,7 +5712,7 @@ To use `flake8' you would set this to (\"flake8\" \"-\")." ;; TYPE (defcustom python-flymake-command-output-pattern (list - "^\\(?:<?stdin>?\\):\\(?1:[0-9]+\\):\\(?:\\(?2:[0-9]+\\):\\)? \\(?3:.*\\)$" + "^\\(?:<?stdin>?\\):\\(?1:[0-9]+\\):\\(?:\\(?2:[0-9]+\\):?\\)? \\(?3:.*\\)$" 1 2 nil 3) "Specify how to parse the output of `python-flymake-command'. The value has the form (REGEXP LINE COLUMN TYPE MESSAGE): if @@ -5649,7 +5724,6 @@ MESSAGE'th gives the message text itself. If COLUMN or TYPE are nil or that index didn't match, that information is not present on the matched line and a default will be used." - :version "26.1" :type '(list regexp (integer :tag "Line's index") (choice @@ -5658,7 +5732,8 @@ be used." (choice (const :tag "No type" nil) (integer :tag "Type's index")) - (integer :tag "Message's index"))) + (integer :tag "Message's index")) + :version "29.1") (defcustom python-flymake-msg-alist '(("\\(^redefinition\\|.*unused.*\\|used$\\)" . :warning)) @@ -5780,7 +5855,9 @@ REPORT-FN is Flymake's callback function." `(,python-font-lock-keywords nil nil nil nil (font-lock-syntactic-face-function - . python-font-lock-syntactic-face-function))) + . python-font-lock-syntactic-face-function) + (font-lock-extend-after-change-region-function + . python-font-lock-extend-region))) (setq-local syntax-propertize-function python-syntax-propertize-function) @@ -5835,17 +5912,19 @@ REPORT-FN is Flymake's callback function." (add-to-list 'hs-special-modes-alist - '(python-mode - "\\s-*\\_<\\(?:def\\|class\\)\\_>" + `(python-mode + ,python-nav-beginning-of-block-regexp ;; Use the empty string as end regexp so it doesn't default to ;; "\\s)". This way parens at end of defun are properly hidden. "" "#" python-hideshow-forward-sexp-function - nil)) + nil + python-nav-beginning-of-block + python-hideshow-find-next-block + python-info-looking-at-beginning-of-block)) (setq-local outline-regexp (python-rx (* space) block-start)) - (setq-local outline-heading-end-regexp ":[^\n]*\n") (setq-local outline-level (lambda () "`outline-level' function for Python mode." @@ -5862,6 +5941,60 @@ REPORT-FN is Flymake's callback function." (add-hook 'flymake-diagnostic-functions #'python-flymake nil t)) +;;; Completion predicates for M-x +;; Commands that only make sense when editing Python code +(dolist (sym '(python-check + python-fill-paragraph + python-indent-dedent-line + python-indent-dedent-line-backspace + python-indent-guess-indent-offset + python-indent-shift-left + python-indent-shift-right + python-mark-defun + python-nav-backward-block + python-nav-backward-defun + python-nav-backward-sexp + python-nav-backward-sexp-safe + python-nav-backward-statement + python-nav-backward-up-list + python-nav-beginning-of-block + python-nav-beginning-of-statement + python-nav-end-of-block + python-nav-end-of-defun + python-nav-end-of-statement + python-nav-forward-block + python-nav-forward-defun + python-nav-forward-sexp + python-nav-forward-sexp-safe + python-nav-forward-statement + python-nav-if-name-main + python-nav-up-list + python-shell-send-buffer + python-shell-send-defun + python-shell-send-statement)) + (put sym 'completion-predicate #'python--completion-predicate)) + +(defun python-shell--completion-predicate (_ buffer) + (provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + 'python-mode 'inferior-python-mode)) + +;; Commands that only make sense in the Python shell or when editing +;; Python code. +(dolist (sym '(python-describe-at-point + python-eldoc-at-point + python-shell-completion-native-toggle + python-shell-completion-native-turn-off + python-shell-completion-native-turn-on + python-shell-completion-native-turn-on-maybe + python-shell-font-lock-cleanup-buffer + python-shell-font-lock-toggle + python-shell-font-lock-turn-off + python-shell-font-lock-turn-on + python-shell-package-enable + python-shell-completion-complete-or-indent )) + (put sym 'completion-predicate #'python-shell--completion-predicate)) + (provide 'python) ;;; python.el ends here diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 87bb92908d1..955daa393ce 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1147,7 +1147,7 @@ delimiter." (setq re (regexp-quote (or (match-string 4) (match-string 2)))) (if (match-beginning 1) (setq re (concat "\\s *" re))) (let* ((id-end (goto-char (match-end 0))) - (line-end-position (point-at-eol)) + (line-end-position (line-end-position)) (state (list in-string nest depth pcol indent))) ;; parse the rest of the line (while (and (> line-end-position (point)) @@ -1924,7 +1924,7 @@ It will be properly highlighted even when the call omits parens.") (save-excursion (forward-char -1) (looking-back ruby-syntax-before-regexp-re - (point-at-bol)))) + (line-beginning-position)))) ;; End of regexp. We don't match the whole ;; regexp at once because it can have ;; string interpolation inside, or span diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index f063fb5a7ca..fa799a0fb37 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -1824,7 +1824,7 @@ If set will become buffer local.") ;; (defsubst verilog-within-string () - (nth 3 (parse-partial-sexp (point-at-bol) (point)))) + (nth 3 (parse-partial-sexp (line-beginning-position) (point)))) (defsubst verilog-string-match-fold (regexp string &optional start) "Like `string-match', but use `verilog-case-fold'. @@ -1927,7 +1927,7 @@ This speeds up complicated regexp matches." (search-forward substr bound noerror)) (save-excursion (beginning-of-line) - (setq done (re-search-forward regexp (point-at-eol) noerror))) + (setq done (re-search-forward regexp (line-end-position) noerror))) (unless (and (<= (match-beginning 0) (point)) (>= (match-end 0) (point))) (setq done nil))) @@ -1947,7 +1947,7 @@ This speeds up complicated regexp matches." (search-backward substr bound noerror)) (save-excursion (end-of-line) - (setq done (re-search-backward regexp (point-at-bol) noerror))) + (setq done (re-search-backward regexp (line-beginning-position) noerror))) (unless (and (<= (match-beginning 0) (point)) (>= (match-end 0) (point))) (setq done nil))) @@ -4908,7 +4908,7 @@ primitive or interface named NAME." (or kill-existing-comment (not (save-excursion (end-of-line) - (search-backward "//" (point-at-bol) t))))) + (search-backward "//" (line-beginning-position) t))))) (let ((nest 1) b e m (else (if (match-end 2) "!" " "))) @@ -4961,7 +4961,7 @@ primitive or interface named NAME." (or kill-existing-comment (not (save-excursion (end-of-line) - (search-backward "//" (point-at-bol) t))))) + (search-backward "//" (line-beginning-position) t))))) (let ((type (car indent-str))) (unless (eq type 'declaration) (unless (looking-at (concat "\\(" verilog-end-block-ordered-re "\\)[ \t]*:")) ; ignore named ends @@ -5503,7 +5503,7 @@ becomes: (cond ((looking-at "// surefire lint_off_line ") (goto-char (match-end 0)) - (let ((lim (point-at-eol))) + (let ((lim (line-end-position))) (if (re-search-forward code lim 'move) (throw 'already t) (insert (concat " " code))))) @@ -9958,7 +9958,7 @@ Use DEFAULT-DIR to anchor paths if non-nil." (verilog-point-text) filename)) (goto-char (point-min)) (while (not (eobp)) - (setq line (buffer-substring (point) (point-at-eol))) + (setq line (buffer-substring (point) (line-end-position))) (forward-line 1) (when (string-match "//" line) (setq line (substring line 0 (match-beginning 0)))) @@ -14758,7 +14758,7 @@ Clicking on the middle-mouse button loads them in a buffer (as in dired)." (verilog-save-scan-cache (let (end-point) (goto-char end) - (setq end-point (point-at-eol)) + (setq end-point (line-end-position)) (goto-char beg) (beginning-of-line) ; scan entire line ;; delete overlays existing on this line diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 39c5eb453b1..b763da3fbc5 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -7707,7 +7707,7 @@ non-nil, indentation is done before aligning." (save-excursion (goto-char begin) (let (element - (eol (point-at-eol))) + (eol (line-end-position))) (setq element (nth 0 copy)) (when (and (or (and (listp (car element)) (memq major-mode (car element))) @@ -7733,7 +7733,7 @@ space is inserted after the token in MATCH." ;; Determine the greatest whitespace distance to the alignment ;; character (goto-char begin) - (setq eol (point-at-eol) + (setq eol (line-end-position) bol (setq begin (progn (beginning-of-line) (point)))) (while (< bol end) (save-excursion @@ -7750,13 +7750,13 @@ space is inserted after the token in MATCH." (setq max distance)))) (forward-line) (setq bol (point) - eol (point-at-eol)) + eol (line-end-position)) (setq lines (1+ lines))) ;; Now insert enough maxs to push each assignment operator to ;; the same column. We need to use 'lines' as a counter, since ;; the location of the mark may change (goto-char (setq bol begin)) - (setq eol (point-at-eol)) + (setq eol (line-end-position)) (while (> lines 0) (when (and (vhdl-re-search-forward match eol t) (save-excursion @@ -7776,7 +7776,7 @@ space is inserted after the token in MATCH." (beginning-of-line) (forward-line) (setq bol (point) - eol (point-at-eol)) + eol (line-end-position)) (setq lines (1- lines)))))) (defun vhdl-align-region-groups (beg end &optional spacing @@ -8647,7 +8647,7 @@ buffer." (forward-char) (vhdl-forward-syntactic-ws)) (goto-char end) - (when (> pos (point-at-eol)) + (when (> pos (line-end-position)) (error "ERROR: Not within a generic/port clause")) ;; delete closing parenthesis on separate line (not supported style) (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);")) @@ -12838,7 +12838,7 @@ expressions (e.g. for index ranges of types and signals)." "Return the line number of the line containing point." (save-restriction (widen) - (1+ (count-lines (point-min) (point-at-bol))))) + (1+ (count-lines (point-min) (line-beginning-position))))) (defun vhdl-line-kill-entire (&optional arg) "Delete entire line." @@ -12855,7 +12855,7 @@ expressions (e.g. for index ranges of types and signals)." "Copy current line." (interactive "p") (save-excursion - (let ((position (point-at-bol))) + (let ((position (line-beginning-position))) (forward-line (or arg 1)) (copy-region-as-kill position (point))))) @@ -14958,8 +14958,8 @@ otherwise use cached data." (defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg package-alist ent-inst-list depth) - "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACKAGE-ALIST." - (if (not (or ent-alist conf-alist package-alist)) + "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PACKAGE-ALIST." + (if (not (or ent-alist-arg conf-alist-arg package-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) (let ((ent-alist ent-alist-arg) (conf-alist conf-alist-arg) @@ -16752,7 +16752,7 @@ current project/directory." (let ((ent-alist ent-alist-arg) (conf-alist conf-alist-arg) (margin (current-indentation)) - (beg (point-at-bol)) + (beg (line-beginning-position)) ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key ;; insert block configuration (for architecture) (vhdl-insert-keyword "FOR ") (insert arch-name "\n") diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index f3db971bcf2..a7e372c2ac6 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1764,6 +1764,12 @@ utility function used by commands like `dired-do-find-regexp' and :version "28.1" :package-version '(xref . "1.0.4")) +(defmacro xref--with-connection-local-variables (&rest body) + (declare (debug t)) + (if (>= emacs-major-version 27) + `(with-connection-local-variables ,@body) + `(progn ,@body))) + ;;;###autoload (defun xref-matches-in-files (regexp files) "Find all matches for REGEXP in FILES. @@ -1810,13 +1816,14 @@ to control which program to use when looking for matches." (insert (mapconcat #'identity files "\0")) (setq default-directory dir) (setq status - (xref--process-file-region (point-min) - (point-max) - shell-file-name - output - nil - shell-command-switch - command))) + (xref--with-connection-local-variables + (xref--process-file-region (point-min) + (point-max) + shell-file-name + output + nil + shell-command-switch + command)))) (goto-char (point-min)) (when (and (/= (point-min) (point-max)) (not (looking-at grep-re)) diff --git a/lisp/rect.el b/lisp/rect.el index 6babd046051..e1d79da962e 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -218,7 +218,7 @@ The returned value has the form of (WIDTH . HEIGHT)." (point))))) (defun delete-extract-rectangle-line (startcol endcol lines fill) - (let ((pt (point-at-eol))) + (let ((pt (line-end-position))) (if (< (move-to-column startcol (if fill t 'coerce)) startcol) (setcdr lines (cons (spaces-string (- endcol startcol)) (cdr lines))) @@ -397,13 +397,13 @@ no text on the right side of the rectangle." (defun open-rectangle-line (startcol endcol fill) (when (= (move-to-column startcol (if fill t 'coerce)) startcol) (unless (and (not fill) - (= (point) (point-at-eol))) + (= (point) (line-end-position))) (indent-to endcol)))) (defun delete-whitespace-rectangle-line (startcol _endcol fill) (when (= (move-to-column startcol (if fill t 'coerce)) startcol) - (unless (= (point) (point-at-eol)) - (delete-region (point) (progn (skip-syntax-forward " " (point-at-eol)) + (unless (= (point) (line-end-position)) + (delete-region (point) (progn (skip-syntax-forward " " (line-end-position)) (point)))))) ;;;###autoload @@ -568,7 +568,7 @@ rectangle which were empty." (apply-on-rectangle 'clear-rectangle-line start end fill)) (defun clear-rectangle-line (startcol endcol fill) - (let ((pt (point-at-eol))) + (let ((pt (line-end-position))) (when (= (move-to-column startcol (if fill t 'coerce)) startcol) (if (and (not fill) (<= (save-excursion (goto-char pt) (current-column)) endcol)) diff --git a/lisp/server.el b/lisp/server.el index a06f2f952fd..dd7bccaf331 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -544,7 +544,8 @@ Creates the directory if necessary and makes sure: (setq dir (directory-file-name dir)) (let ((attrs (file-attributes dir 'integer))) (unless attrs - (cl-letf (((default-file-modes) ?\700)) (make-directory dir t)) + (with-file-modes ?\700 + (make-directory dir t)) (setq attrs (file-attributes dir 'integer))) ;; Check that it's safe for use. @@ -691,7 +692,7 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) (server-ensure-safe-dir server-dir) (when server-process (server-log (message "Restarting server"))) - (cl-letf (((default-file-modes) ?\700)) + (with-file-modes ?\700 (add-hook 'suspend-tty-functions #'server-handle-suspend-tty) (add-hook 'delete-frame-functions #'server-handle-delete-frame) (add-hook 'kill-emacs-query-functions diff --git a/lisp/simple.el b/lisp/simple.el index 1e6e5e11e00..daacf697ff3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1402,15 +1402,17 @@ instead of deleted." :version "24.1") (setq region-extract-function - (lambda (method) - (when (region-beginning) - (cond - ((eq method 'bounds) - (list (cons (region-beginning) (region-end)))) - ((eq method 'delete-only) - (delete-region (region-beginning) (region-end))) - (t - (filter-buffer-substring (region-beginning) (region-end) method)))))) + (lambda (method) + ;; This call either signals an error (if there is no region) + ;; or returns a number. + (let ((beg (region-beginning))) + (cond + ((eq method 'bounds) + (list (cons beg (region-end)))) + ((eq method 'delete-only) + (delete-region beg (region-end))) + (t + (filter-buffer-substring beg (region-end) method)))))) (defvar region-insert-function (lambda (lines) @@ -2714,12 +2716,15 @@ don't clear it." (t ;; Pass `cmd' rather than `final', for the backtrace's sake. (prog1 (call-interactively cmd record-flag keys) - (when (and (symbolp cmd) - (get cmd 'byte-obsolete-info) - (not (get cmd 'command-execute-obsolete-warned))) + (when-let ((info + (and (symbolp cmd) + (not (get cmd 'command-execute-obsolete-warned)) + (get cmd 'byte-obsolete-info)))) (put cmd 'command-execute-obsolete-warned t) (message "%s" (macroexp--obsolete-warning - cmd (get cmd 'byte-obsolete-info) "command")))))))))) + cmd info "command" + (help--key-description-fontified + (where-is-internal (car info) nil t)))))))))))) (defun command-execute--query (command) "Query the user whether to run COMMAND." @@ -7294,7 +7299,7 @@ or \"mark.*active\" at the prompt." (define-minor-mode indent-tabs-mode "Toggle whether indentation can insert TAB characters." - :global t :group 'indent :variable indent-tabs-mode) + :group 'indent) (defvar widen-automatically t "Non-nil means it is ok for commands to call `widen' when they want to. @@ -7695,13 +7700,7 @@ not vscroll." ;; Lines are not truncated... (not (and - (or truncate-lines - (and (integerp truncate-partial-width-windows) - (< (window-total-width) - truncate-partial-width-windows)) - (and truncate-partial-width-windows - (not (integerp truncate-partial-width-windows)) - (not (window-full-width-p)))) + (or truncate-lines (truncated-partial-width-window-p)) ;; ...or if lines are truncated, this buffer ;; doesn't have very long lines. (long-line-optimizations-p))) @@ -7712,13 +7711,9 @@ not vscroll." (not goal-column) ;; Lines aren't truncated. (not - (or truncate-lines - (and (integerp truncate-partial-width-windows) - (< (window-width) - truncate-partial-width-windows)) - (and truncate-partial-width-windows - (not (integerp truncate-partial-width-windows)) - (not (window-full-width-p))))) + (and + (or truncate-lines (truncated-partial-width-window-p)) + (long-line-optimizations-p))) ;; When the text in the window is scrolled to the left, ;; display-based motion doesn't make sense (because each ;; logical line occupies exactly one screen line). @@ -10395,8 +10390,15 @@ command works by setting the variable `buffer-read-only', which does not affect read-only regions caused by text properties. To ignore read-only status in a Lisp program (whether due to text properties or buffer state), bind `inhibit-read-only' temporarily -to a non-nil value." +to a non-nil value. + +Reverting a buffer will keep the read-only status set by using +this command." :variable buffer-read-only + ;; We're saving this value here so that we can restore the + ;; readedness state after reverting the buffer to the value that's + ;; been explicitly set by the user. + (setq-local read-only-mode--state buffer-read-only) (cond ((and (not buffer-read-only) view-mode) (View-exit-and-edit) diff --git a/lisp/subr.el b/lisp/subr.el index cd6a9be099c..36f5e2fee49 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1911,12 +1911,11 @@ be a list of the form returned by `event-start' and `event-end'." (defalias 'store-match-data #'set-match-data) (defalias 'chmod #'set-file-modes) (defalias 'mkdir #'make-directory) -;; These are the XEmacs names: -(defalias 'point-at-eol #'line-end-position) -(defalias 'point-at-bol #'line-beginning-position) -(define-obsolete-function-alias 'user-original-login-name - #'user-login-name "28.1") +;; These were the XEmacs names, now obsolete: +(define-obsolete-function-alias 'point-at-eol #'line-end-position "29.1") +(define-obsolete-function-alias 'point-at-bol #'line-beginning-position "29.1") +(define-obsolete-function-alias 'user-original-login-name #'user-login-name "28.1") ;; These are in obsolete/autoload.el, but are commonly used by ;; third-party scripts that assume that they exist without requiring @@ -6904,10 +6903,7 @@ OBJECT if it is readable." (defun delete-line () "Delete the current line." - (delete-region (line-beginning-position) - (progn - (forward-line 1) - (point)))) + (delete-region (pos-bol) (pos-bol 2))) (defun ensure-empty-lines (&optional lines) "Ensure that there are LINES number of empty lines before point. diff --git a/lisp/term.el b/lisp/term.el index 11c2d2aaa16..797fb18074f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2862,13 +2862,13 @@ See `term-prompt-regexp'." (defun term-move-to-column (column) (setq term-current-column column) - (let ((point-at-eol (line-end-position))) + (let ((line-end-position (line-end-position))) (move-to-column term-current-column t) ;; If move-to-column extends the current line it will use the face ;; from the last character on the line, set the face for the chars ;; to default. - (when (> (point) point-at-eol) - (put-text-property point-at-eol (point) 'font-lock-face 'default)))) + (when (> (point) line-end-position) + (put-text-property line-end-position (point) 'font-lock-face 'default)))) ;; Move DELTA column right (or left if delta < 0 limiting at column 0). (defun term-move-columns (delta) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index e26191b33b4..82b6281eb69 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -435,13 +435,14 @@ Lines are highlighted according to `ns-input-line'." ;; nsterm.m (declare-function ns-read-file-name "nsfns.m" - (prompt &optional dir mustmatch init dir_only_p)) + (prompt &optional dir mustmatch init dir-only-p)) ;;;; File handling. -(defun x-file-dialog (prompt dir default_filename mustmatch only_dir_p) +(defun x-file-dialog (prompt dir &optional default-filename + mustmatch only-dir-p) "SKIP: real doc in xfns.c." - (ns-read-file-name prompt dir mustmatch default_filename only_dir_p)) + (ns-read-file-name prompt dir mustmatch default-filename only-dir-p)) (defun ns-open-file-using-panel () "Pop up open-file panel, and load the result in a buffer." diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index ee1aad3d0ec..b93e259d82a 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -229,7 +229,7 @@ EVENT is a `preedit-text-event'." '( ("etc/images/new" . ("document-new" "gtk-new")) ("etc/images/open" . ("document-open" "gtk-open")) - ("etc/images/diropen" . "n:system-file-manager") + ("etc/images/diropen" . "gtk-directory") ("etc/images/close" . ("window-close" "gtk-close")) ("etc/images/save" . ("document-save" "gtk-save")) ("etc/images/saveas" . ("document-save-as" "gtk-save-as")) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 55fe11a097c..38266baa969 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1380,7 +1380,7 @@ This returns an error if any Emacs frames are X frames." '( ("etc/images/new" . ("document-new" "gtk-new")) ("etc/images/open" . ("document-open" "gtk-open")) - ("etc/images/diropen" . "n:system-file-manager") + ("etc/images/diropen" . "gtk-directory") ("etc/images/close" . ("window-close" "gtk-close")) ("etc/images/save" . ("document-save" "gtk-save")) ("etc/images/saveas" . ("document-save-as" "gtk-save-as")) diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index f940de3ff41..c3c9af5a834 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -139,11 +139,9 @@ not align (only setting space according to `conf-assignment-space')." "Syntax table in use in Unix style `conf-mode' buffers.") (defvar conf-javaprop-mode-syntax-table - (let ((table (make-syntax-table conf-unix-mode-syntax-table))) - (modify-syntax-entry ?/ ". 124" table) - (modify-syntax-entry ?* ". 23b" table) - table) + (make-syntax-table conf-unix-mode-syntax-table) "Syntax table in use in Java properties buffers.") +(make-obsolete-variable 'conf-javaprop-mode-syntax-table nil "29.1") (defvar conf-ppd-mode-syntax-table (let ((table (make-syntax-table conf-mode-syntax-table))) @@ -470,13 +468,9 @@ PersistMoniker=file://Folder.htt" ;;;###autoload (define-derived-mode conf-javaprop-mode conf-mode "Conf[JavaProp]" "Conf Mode starter for Java properties files. -Comments start with `#' but are also recognized with `//' or -between `/*' and `*/'. -For details see `conf-mode'. Example: +Comments start with `#'. Example: # Conf mode font-locks this right with \\[conf-javaprop-mode] (Java properties) -// another kind of comment -/* yet another */ name:value name=value @@ -487,7 +481,6 @@ x.2.y.1.z.2.zz =" (conf-mode-initialize "#" 'conf-javaprop-font-lock-keywords) (setq-local conf-assignment-column conf-javaprop-assignment-column) (setq-local conf-assignment-regexp ".+?\\([ \t]*[=: \t][ \t]*\\|$\\)") - (setq-local comment-start-skip "\\(?:#+\\|/[/*]+\\)\\s *") (setq-local imenu-generic-expression '(("Parameters" "^[ \t]*\\(.+?\\)[=: \t]" 1)))) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index a2a7774aba7..d2a35bd550f 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1711,7 +1711,7 @@ be used to fill comments. ;; comment. (when (save-excursion (beginning-of-line) - (comment-search-forward (point-at-eol) t)) + (comment-search-forward (line-end-position) t)) (goto-char (match-end 0))) (let ((ppss (syntax-ppss)) (eol (line-end-position))) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 2ee20ef1d45..a893bc7b9ce 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1553,7 +1553,7 @@ The buffer to mark them in is `flyspell-large-region-buffer'." (goto-char (point-min)) ;; Localwords parsing copied from ispell.el. (while (search-forward ispell-words-keyword nil t) - (let ((end (point-at-eol)) + (let ((end (line-end-position)) string) ;; buffer-local words separated by a space, and can contain ;; any character other than a space. Not rigorous enough. @@ -1714,25 +1714,32 @@ of a misspelled word removed when you've corrected it." ;;*---------------------------------------------------------------------*/ ;;* flyspell-goto-next-error ... */ ;;*---------------------------------------------------------------------*/ -(defun flyspell-goto-next-error () - "Go to the next previously detected error. +(defun flyspell-goto-next-error (&optional previous) + "Go to the next error. +If PREVIOUS (interactively, the prefix), go to the previous error +instead. + In general FLYSPELL-GOTO-NEXT-ERROR must be used after FLYSPELL-BUFFER." - (interactive) + (interactive "P") (let ((pos (point)) - (max (point-max))) - (if (and (eq (current-buffer) flyspell-old-buffer-error) - (eq pos flyspell-old-pos-error)) - (progn - (if (= flyspell-old-pos-error max) - ;; goto beginning of buffer + (max (if previous (point-min) (point-max)))) + (when (and (eq (current-buffer) flyspell-old-buffer-error) + (eq pos flyspell-old-pos-error)) + (if previous + (if (= flyspell-old-pos-error max) (progn - (message "Restarting from beginning of buffer") - (goto-char (point-min))) - (forward-word 1)) - (setq pos (point)))) - ;; seek the next error - (while (and (< pos max) + (message "Restarting from end of the buffer") + (goto-char (point-max))) + (forward-word -1)) + (if (= flyspell-old-pos-error max) + (progn + (message "Restarting from beginning of buffer") + (goto-char (point-min))) + (forward-word 1))) + (setq pos (point))) + ;; Seek the next error. + (while (and (/= pos max) (let ((ovs (overlays-at pos)) (r '())) (while (and (not r) (consp ovs)) @@ -1740,13 +1747,15 @@ FLYSPELL-BUFFER." (setq r t) (setq ovs (cdr ovs)))) (not r))) - (setq pos (1+ pos))) - ;; save the current location for next invocation - (setq flyspell-old-pos-error pos) - (setq flyspell-old-buffer-error (current-buffer)) + (setq pos (if previous (1- pos) (1+ pos)))) (goto-char pos) - (if (= pos max) - (message "No more miss-spelled word!")))) + (when previous + (forward-word -1)) + ;; Save the current location for next invocation. + (setq flyspell-old-pos-error (point)) + (setq flyspell-old-buffer-error (current-buffer)) + (when (= (point) max) + (message "No more miss-spelled words")))) ;;*---------------------------------------------------------------------*/ ;;* flyspell-overlay-p ... */ diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index f85d0aba9cf..8e633688091 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1062,12 +1062,14 @@ calls it only when invoked interactively." (cl-pushnew (list dict '()) ispell-dictionary-alist :test #'equal) (ispell-hunspell-fill-dictionary-entry dict)) -(defun ispell-find-hunspell-dictionaries () +(defun ispell-find-hunspell-dictionaries (&optional dictionary) "Look for installed Hunspell dictionaries. Will initialize `ispell-hunspell-dictionary-alist' according to dictionaries found, and will remove aliases from the list in `ispell-dicts-name2locale-equivs-alist' if an explicit -dictionary from that list was found." +dictionary from that list was found. + +If DICTIONARY, check for that dictionary explicitly." (let ((hunspell-found-dicts (seq-filter (lambda (str) @@ -1081,23 +1083,20 @@ dictionary from that list was found." (file-name-absolute-p str)) (split-string (with-temp-buffer - (ispell-call-process ispell-program-name - nil - t - nil - "-D" - ;; Use -a to prevent Hunspell from - ;; trying to initialize its - ;; curses/termcap UI, which causes it - ;; to crash or fail to start in some - ;; MS-Windows ports. - "-a" - ;; Hunspell 1.7.0 (and later?) won't - ;; show LOADED DICTIONARY unless - ;; there's at least one file argument - ;; on the command line. So we feed - ;; it with the null device. - null-device) + (apply #'ispell-call-process + ispell-program-name nil t nil + `("-D" + ,@(and dictionary (list "-d" dictionary)) + ;; Use -a to prevent Hunspell from trying to + ;; initialize its curses/termcap UI, which + ;; causes it to crash or fail to start in some + ;; MS-Windows ports. + "-a" + ;; Hunspell 1.7.0 (and later?) won't show LOADED + ;; DICTIONARY unless there's at least one file + ;; argument on the command line. So we feed it + ;; with the null device. + ,null-device)) (buffer-string)) "[\n\r]+" t))) @@ -1164,12 +1163,20 @@ dictionary from that list was found." ;; Parse and set values for default dictionary. (setq hunspell-default-dict (or hunspell-multi-dict (car hunspell-default-dict))) + ;; If we didn't find a dictionary based on the environment (i.e., + ;; the locale and the DICTIONARY variable), try again if + ;; `ispell-dictionary' is set. + (when (and (not hunspell-default-dict) + (not dictionary) + ispell-dictionary) + (setq hunspell-default-dict + (ispell-find-hunspell-dictionaries ispell-dictionary))) ;; If hunspell-default-dict is nil, ispell-parse-hunspell-affix-file ;; will barf with an error message that doesn't help users figure ;; out what is wrong. Produce an error message that points to the ;; root cause of the problem. - (or hunspell-default-dict - (error "Can't find Hunspell dictionary with a .aff affix file")) + (unless hunspell-default-dict + (error "Can't find Hunspell dictionary with a .aff affix file")) (setq hunspell-default-dict-entry (ispell-parse-hunspell-affix-file hunspell-default-dict)) ;; Create an alist of found dicts with only names, except for default dict. @@ -1179,7 +1186,8 @@ dictionary from that list was found." (cl-pushnew (if (string= dict hunspell-default-dict) hunspell-default-dict-entry (list dict)) - ispell-hunspell-dictionary-alist :test #'equal)))) + ispell-hunspell-dictionary-alist :test #'equal)) + hunspell-default-dict)) ;; Make ispell.el work better with enchant. @@ -3146,7 +3154,7 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r (min skip-region-start ispell-region-end) (marker-position ispell-region-end)))) (let* ((ispell-start (point)) - (ispell-end (min (point-at-eol) reg-end)) + (ispell-end (min (line-end-position) reg-end)) ;; See if line must be prefixed by comment string to let ispell know this is ;; part of a comment string. This is only supported in some modes. ;; In particular, this is not supported in autoconf mode where adding the @@ -3159,7 +3167,8 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r ispell-start ispell-end add-comment))) (ispell-print-if-debug "ispell-region: string pos (%s->%s), eol: %s, [in-comment]: [%s], [add-comment]: [%s], [string]: [%s]\n" - ispell-start ispell-end (point-at-eol) in-comment add-comment string) + ispell-start ispell-end (line-end-position) + in-comment add-comment string) (if add-comment ; account for comment chars added (setq ispell-start (- ispell-start (length add-comment)) ;; Reset `in-comment' (and indirectly `add-comment') for new line @@ -4096,7 +4105,7 @@ Includes LaTeX/Nroff modes and extended character mode." (goto-char (point-max)) ;; Uses last occurrence of ispell-parsing-keyword (if (search-backward ispell-parsing-keyword nil t) - (let ((end (point-at-eol)) + (let ((end (line-end-position)) string) (search-forward ispell-parsing-keyword) (while (re-search-forward " *\\([^ \"]+\\)" end t) @@ -4132,7 +4141,7 @@ Both should not be used to define a buffer-local dictionary." (if (search-backward ispell-dictionary-keyword nil t) (progn (search-forward ispell-dictionary-keyword) - (setq end (point-at-eol)) + (setq end (line-end-position)) (if (re-search-forward " *\\([^ \"]+\\)" end t) (setq ispell-local-dictionary (match-string-no-properties 1)))))) @@ -4140,7 +4149,7 @@ Both should not be used to define a buffer-local dictionary." (if (search-backward ispell-pdict-keyword nil t) (progn (search-forward ispell-pdict-keyword) - (setq end (point-at-eol)) + (setq end (line-end-position)) (if (re-search-forward " *\\([^ \"]+\\)" end t) (setq ispell-local-pdict (match-string-no-properties 1))))))) @@ -4169,7 +4178,7 @@ Both should not be used to define a buffer-local dictionary." (while (search-forward ispell-words-keyword nil t) (or ispell-buffer-local-name (setq ispell-buffer-local-name (buffer-name))) - (let ((end (point-at-eol)) + (let ((end (line-end-position)) (ispell-casechars (ispell-get-casechars)) string) ;; buffer-local words separated by a space, and can contain diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index f9f09825fa0..ee94cc5d693 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -100,7 +100,7 @@ (("lstlisting" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting")))) (minted "The minted package" - (("minted" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting")))) + (("listing" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting")))) ;; The LaTeX core stuff (LaTeX "LaTeX default environments" diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 7a654f72ab8..98672f42b3f 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -779,10 +779,10 @@ braces." nil (cond ;; parenthesis - ((looking-back "([^)]*" (point-at-bol 0)) + ((looking-back "([^)]*" (line-beginning-position 0)) "@pxref{") ;; beginning of sentence or buffer - ((or (looking-back (sentence-end) (point-at-bol 0)) + ((or (looking-back (sentence-end) (line-beginning-position 0)) (= (point) (point-min))) "@xref{") ;; bol or eol @@ -790,7 +790,7 @@ braces." "@ref{") ;; inside word ((not (eq (char-syntax (char-after)) ? )) - (skip-syntax-backward "^ " (point-at-bol)) + (skip-syntax-backward "^ " (line-beginning-position)) "@ref{") ;; everything else (t diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 3b31f1d8090..0b3d36d6e31 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -294,6 +294,7 @@ smaller according to whether INCREMENT is 1 or -1." tn)) (declare-function image-size "image.c" (spec &optional pixels frame)) +(declare-function image-supported-file-p "image" (file)) (defun thumbs-file-size (img) (let ((i (image-size diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index e4a1996c1bb..a01943437c1 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -633,7 +633,7 @@ See https://lists.gnu.org/r/emacs-devel/2007-11/msg01990.html") (when (looking-at regexp-hunk) ; Hunk header. (throw 'headerp (point))) (forward-line -1) - (when (re-search-forward regexp-file (point-at-eol 4) t) ; File header. + (when (re-search-forward regexp-file (line-end-position 4) t) ; File header. (forward-line 0) (throw 'headerp (point))) (goto-char orig) @@ -2928,6 +2928,15 @@ hunk text is not found in the source file." (forward-line 1))) (nreverse props))) +;;;###autoload +(defun diff-vc-deduce-fileset () + (let ((backend (vc-responsible-backend default-directory)) + files) + (save-excursion + (goto-char (point-min)) + (while (progn (diff-file-next) (not (eobp))) + (push (diff-find-file-name nil t) files))) + (list backend (nreverse files) nil nil 'patch))) (defun diff--filter-substring (str) (when diff-font-lock-prettify diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index a3e77200ddf..c956cdd2ee6 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -765,7 +765,7 @@ Ediff needs to find fine differences." "Set stipple pixmap of FACE to PIXMAP on a monochrome display." (if (and (display-graphic-p) (not (display-color-p))) (condition-case nil - (set-face-background-pixmap face pixmap) + (set-face-stipple face pixmap) (error (message "Pixmap not found for %S: %s" (face-name face) pixmap) (sit-for 1))))) diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index 94e3fc6d7fe..40473a2c03f 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -89,11 +89,11 @@ ;; underlining. However, if the region is already underlined by some other ;; overlays, there is no simple way to temporarily remove that residual ;; underlining. This problem occurs when a buffer is highlighted with -;; font-lock.el packages. If this residual highlighting gets in the way, you -;; can do the following. font-lock.el provides commands for unhighlighting -;; buffers. You can either place these commands in `ediff-prepare-buffer-hook' -;; (which will unhighlight every buffer used by Ediff) or you can execute -;; them interactively, at any time and in any buffer. +;; font-lock.el. If this residual highlighting gets in the way, you +;; can use the font-lock.el commands for unhighlighting buffers. +;; Either place these commands in `ediff-prepare-buffer-hook' (which will +;; unhighlight every buffer used by Ediff) or execute them +;; interactively, which you can do at any time and in any buffer. ;;; Acknowledgments: diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index e958673fea8..52906163024 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -664,6 +664,19 @@ comment history, see `log-edit-comment-ring', and hides `log-edit-files-buf'." (indent-rigidly (point) (point-max) (- log-edit-common-indent common))))) +(defvar vc-patch-string) + +(autoload 'vc-diff-patch-string "vc") +(defun log-edit-diff-patch () + (vc-diff-patch-string vc-patch-string)) + +(defvar vc-log-fileset) + +(defun log-edit-diff-fileset () + "Display diffs for the files to be committed." + (interactive) + (vc-diff nil nil (list log-edit-vc-backend vc-log-fileset))) + (defun log-edit-show-diff () "Show the diff for the files to be committed." (interactive) diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index e2a490092b5..36a6f27891b 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -624,6 +624,8 @@ NOT-URGENT means it is ok to continue if the user says not to save." (declare-function log-edit-empty-buffer-p "log-edit" ()) +(defvar vc-patch-string) + (defun vc-log-edit (fileset mode backend) "Set up `log-edit' for use on FILE." (setq default-directory @@ -653,15 +655,17 @@ NOT-URGENT means it is ok to continue if the user says not to save." (mapcar (lambda (file) (file-relative-name file root)) fileset)))) - (log-edit-diff-function . vc-diff) + (log-edit-diff-function + . ,(if vc-patch-string 'log-edit-diff-patch 'log-edit-diff-fileset)) (log-edit-vc-backend . ,backend) - (vc-log-fileset . ,fileset)) + (vc-log-fileset . ,fileset) + (vc-patch-string . ,vc-patch-string)) nil mode) (set-buffer-modified-p nil) (setq buffer-file-name nil)) -(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend) +(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend patch-string) "Accept a comment for an operation on FILES. If COMMENT is nil, pop up a LOGBUF buffer, emit MSG, and set the action on close to ACTION. If COMMENT is a string and @@ -673,7 +677,8 @@ empty comment. Remember the file's buffer in `vc-parent-buffer' \(current one if no file). Puts the log-entry buffer in major mode MODE, defaulting to `log-edit-mode' if MODE is nil. AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'. -BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer." +BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer. +PATCH-STRING is a patch to check in." (let ((parent (if (vc-dispatcher-browsing) ;; If we are called from a directory browser, the parent buffer is @@ -688,6 +693,8 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer." (setq-local vc-parent-buffer parent) (setq-local vc-parent-buffer-name (concat " from " (buffer-name vc-parent-buffer))) + (when patch-string + (setq-local vc-patch-string patch-string)) (vc-log-edit files mode backend) (make-local-variable 'vc-log-after-operation-hook) (when after-hook @@ -753,7 +760,8 @@ the buffer contents as a comment." (defun vc-dispatcher-browsing () "Are we in a directory browser buffer?" (or (derived-mode-p 'vc-dir-mode) - (derived-mode-p 'dired-mode))) + (derived-mode-p 'dired-mode) + (derived-mode-p 'diff-mode))) ;; These are unused. ;; (defun vc-dispatcher-in-fileset-p (fileset) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 46a486a46c3..7395253745e 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -53,7 +53,8 @@ ;; - responsible-p (file) OK ;; - receive-file (file rev) NOT NEEDED ;; - unregister (file) OK -;; * checkin (files rev comment) OK +;; * checkin (files comment rev) OK +;; - checkin-patch (patch-string comment) OK ;; * find-revision (file rev buffer) OK ;; * checkout (file &optional rev) OK ;; * revert (file &optional contents-done) OK @@ -914,6 +915,12 @@ If toggling on, also insert its message into the buffer." "Major mode for editing Git log messages. It is based on `log-edit-mode', and has Git-specific extensions.") +(defvar vc-git-patch-string nil) + +(defun vc-git-checkin-patch (patch-string comment) + (let ((vc-git-patch-string patch-string)) + (vc-git-checkin nil comment))) + (defun vc-git-checkin (files comment &optional _rev) (let* ((file1 (or (car files) default-directory)) (root (vc-git-root file1)) @@ -936,12 +943,21 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (if (eq system-type 'windows-nt) (let ((default-directory (file-name-directory file1))) (make-nearby-temp-file "git-msg"))))) + (when vc-git-patch-string + (unless (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet")) + (user-error "Index not empty")) + (let ((patch-file (make-temp-file "git-patch"))) + (with-temp-file patch-file + (insert vc-git-patch-string)) + (unwind-protect + (vc-git-command nil 0 patch-file "apply" "--cached") + (delete-file patch-file)))) (cl-flet ((boolean-arg-fn (argument) (lambda (value) (when (equal value "yes") (list argument))))) ;; When operating on the whole tree, better pass "-a" than ".", since "." ;; fails when we're committing a merge. - (apply #'vc-git-command nil 0 (if only files) + (apply #'vc-git-command nil 0 (if (and only (not vc-git-patch-string)) files) (nconc (if msg-file (list "commit" "-F" (file-local-name msg-file)) (list "commit" "-m")) @@ -959,7 +975,8 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (write-region (car args) nil msg-file)) (setq args (cdr args))) args) - (if only (list "--only" "--") '("-a"))))) + (unless vc-git-patch-string + (if only (list "--only" "--") '("-a")))))) (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file)))) (defun vc-git-find-revision (file rev buffer) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 61976288e35..f4a44df3c29 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -907,7 +907,7 @@ if we don't understand a construct, we signal ;; should cover the common cases. Remember that we fall back ;; to regular hg commands if we see something we don't like. (save-restriction - (narrow-to-region (point) (point-at-eol)) + (narrow-to-region (point) (line-end-position)) (cond ((looking-at "[ \t]*\\(?:#.*\\)?$")) ((looking-at "syntax:[ \t]*re[ \t]*$") (setf default-syntax 'vc-hg--hgignore-add-pcre)) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 270877041aa..08b53a7169f 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -224,12 +224,10 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (let (process-file-side-effects) (vc-svn-command "*vc*" 0 nil "info")) (let ((repo - (save-excursion - (and (progn - (set-buffer "*vc*") - (goto-char (point-min)) - (re-search-forward "Repository Root: *\\(.*\\)" nil t)) - (match-string 1))))) + (with-current-buffer "*vc*" + (goto-char (point-min)) + (when (re-search-forward "Repository Root: *\\(.*\\)" nil t) + (match-string 1))))) (concat (cond (repo (concat diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index b05adfb2d54..d93be951a3c 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -247,6 +247,11 @@ ;; revision argument is only supported with some older VCSes, like ;; RCS and CVS, and is otherwise silently ignored. ;; +;; - checkin-patch (patch-string comment) +;; +;; Commit a single patch PATCH-STRING to this backend, bypassing +;; the changes in filesets. COMMENT is used as a check-in comment. +;; ;; * find-revision (file rev buffer) ;; ;; Fetch revision REV of file FILE and put it into BUFFER. @@ -1102,6 +1107,8 @@ BEWARE: this function may change the current buffer." (vc-dir-deduce-fileset state-model-only-files)) ((derived-mode-p 'dired-mode) (dired-vc-deduce-fileset state-model-only-files not-state-changing)) + ((derived-mode-p 'diff-mode) + (diff-vc-deduce-fileset)) ((setq backend (vc-backend buffer-file-name)) (if state-model-only-files (list backend (list buffer-file-name) @@ -1114,7 +1121,8 @@ BEWARE: this function may change the current buffer." (or (buffer-file-name vc-parent-buffer) (with-current-buffer vc-parent-buffer (or (derived-mode-p 'vc-dir-mode) - (derived-mode-p 'dired-mode))))) + (derived-mode-p 'dired-mode) + (derived-mode-p 'diff-mode))))) (progn ;FIXME: Why not `with-current-buffer'? --Stef. (set-buffer vc-parent-buffer) (vc-deduce-fileset-1 not-state-changing allow-unregistered state-model-only-files))) @@ -1230,6 +1238,8 @@ with, using the most specific one." (error "Fileset files are missing, so cannot be operated on")) ((eq state 'ignored) (error "Fileset files are ignored by the version-control system")) + ((eq model 'patch) + (vc-checkin files backend nil nil nil (buffer-string))) ((or (null state) (eq state 'unregistered)) (cond (verbose (let ((backend (vc-read-backend "Backend to register to: "))) @@ -1615,13 +1625,14 @@ Type \\[vc-next-action] to check in changes.") ".\n") (message "Please explain why you stole the lock. Type C-c C-c when done."))) -(defun vc-checkin (files backend &optional comment initial-contents rev) +(defun vc-checkin (files backend &optional comment initial-contents rev patch-string) "Check in FILES. COMMENT is a comment string; if omitted, a buffer is popped up to accept a comment. If INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents of the log entry buffer. The optional argument REV may be a string specifying the new revision level (only supported for some older VCSes, like RCS and CVS). +The optional argument PATCH-STRING is a string to check in as a patch. Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (run-hooks 'vc-before-checkin-hook) @@ -1643,7 +1654,9 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." ;; vc-checkin-switches, but 'the' local buffer is ;; not a well-defined concept for filesets. (progn - (vc-call-backend backend 'checkin files comment rev) + (if patch-string + (vc-call-backend backend 'checkin-patch patch-string comment) + (vc-call-backend backend 'checkin files comment rev)) (mapc #'vc-delete-automatic-version-backups files)) `((vc-state . up-to-date) (vc-checkout-time . ,(file-attribute-modification-time @@ -1651,7 +1664,8 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (vc-working-revision . nil))) (message "Checking in %s...done" (vc-delistify files))) 'vc-checkin-hook - backend)) + backend + patch-string)) ;;; Additional entry points for examining version histories @@ -1779,6 +1793,25 @@ objects, and finally killing buffer ORIGINAL." (defvar vc-diff-added-files nil "If non-nil, diff added files by comparing them to /dev/null.") +(defvar vc-patch-string nil) + +(defun vc-diff-patch-string (patch-string) + "Report diffs to be committed from the patch. +Like `vc-diff-internal' but uses PATCH-STRING to display +in the output buffer." + (let ((buffer "*vc-diff*")) + (vc-setup-buffer buffer) + (let ((buffer-undo-list t) + (inhibit-read-only t)) + (insert patch-string)) + (setq buffer-read-only t) + (diff-mode) + (setq-local diff-vc-backend (vc-responsible-backend default-directory)) + (setq-local revert-buffer-function (lambda (_ _) (vc-diff-patch-string))) + (setq-local vc-patch-string patch-string) + (pop-to-buffer (current-buffer)) + (vc-run-delayed (vc-diff-finish (current-buffer) nil)))) + (defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose buffer) "Report diffs between two revisions of a fileset. Output goes to the buffer BUFFER, which defaults to *vc-diff*. @@ -1968,19 +2001,20 @@ state of each file in the fileset." (when buffer-file-name (vc-buffer-sync not-urgent)))) ;;;###autoload -(defun vc-diff (&optional historic not-urgent) +(defun vc-diff (&optional historic not-urgent fileset) "Display diffs between file revisions. Normally this compares the currently selected fileset with their working revisions. With a prefix argument HISTORIC, it reads two revision designators specifying which revisions to compare. The optional argument NOT-URGENT non-nil means it is ok to say no to -saving the buffer." +saving the buffer. The optional argument FILESET can override the +deduced fileset." (interactive (list current-prefix-arg t)) (if historic (call-interactively 'vc-version-diff) (vc-maybe-buffer-sync not-urgent) - (let ((fileset (vc-deduce-fileset t))) + (let ((fileset (or fileset (vc-deduce-fileset t)))) (vc-buffer-sync-fileset fileset not-urgent) (vc-diff-internal t fileset nil nil (called-interactively-p 'interactive))))) @@ -2294,7 +2328,7 @@ changes from the current branch." ((vc-find-backend-function backend 'merge-branch) (vc-call-backend backend 'merge-branch)) ;; Otherwise, do a per-file merge. - ((vc-find-backend-function backend 'merge) + ((vc-find-backend-function backend 'merge-file) (vc-buffer-sync) (dolist (file files) (let* ((state (vc-state file)) diff --git a/lisp/vcursor.el b/lisp/vcursor.el index a54227c1bce..e7dd1ba7156 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -232,11 +232,10 @@ ;; ======================= ;; ;; If Emacs has set the variable window-system to nil, vcursor will -;; assume that overlays cannot be displayed in a different face, -;; and will instead use a string (the variable vcursor-string, by -;; default "**>") to show its position. This was first implemented -;; in Emacs 19.29. Unlike the old-fashioned overlay arrow (as used -;; by debuggers), this appears between existing text, which can +;; assume that overlays cannot be displayed in a different face, and +;; will instead use a string (the variable vcursor-string, by default "**>") +;; to show its position. Unlike the old-fashioned overlay arrow (as +;; used by debuggers), this appears between existing text, which can ;; make it hard to read if you're not used to it. (This seemed the ;; better option here.) This means moving the vcursor up and down is ;; a very efficient way of locating it! diff --git a/lisp/view.el b/lisp/view.el index 287112f2d44..1207f01db21 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -441,7 +441,9 @@ Entry to view-mode runs the normal hook `view-mode-hook'." (setq view-page-size nil view-half-page-size nil view-old-buffer-read-only buffer-read-only - buffer-read-only t)) + buffer-read-only t) + ;; Make reverting the buffer preserve unreadableness. + (setq-local read-only-mode--state t)) (define-obsolete-function-alias 'view-mode-enable 'view-mode "24.4") diff --git a/lisp/wdired.el b/lisp/wdired.el index 106d57174d5..33e0b96f0f5 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -27,16 +27,16 @@ ;; wdired.el (the "w" is for writable) provides an alternative way of ;; renaming files. ;; -;; Have you ever wanted to use C-x r t (string-rectangle), M-% -;; (query-replace), M-c (capitalize-word), etc... to change the name of -;; the files in a "dired" buffer? Now you can do this. All the power -;; of Emacs commands are available when renaming files! +;; Have you ever wanted to use `C-x r t' (`string-rectangle'), `M-%' +;; (`query-replace'), `M-c' (`capitalize-word'), etc... to change the +;; name of the files in a Dired buffer? Now you can do this. All the +;; power of Emacs commands are available when renaming files! ;; ;; This package provides a function that makes the filenames of a -;; dired buffer editable, by changing the buffer mode (which inhibits -;; all of the commands of dired mode). Here you can edit the names of -;; one or more files and directories, and when you press C-c C-c, the -;; renaming takes effect and you are back to dired mode. +;; Dired buffer editable, by changing the buffer mode (which inhibits +;; all of the commands of Dired mode). Here you can edit the names of +;; one or more files and directories, and when you press `C-c C-c', +;; the renaming takes effect and you are back to dired mode. ;; ;; Other things you can do with WDired: ;; @@ -46,11 +46,11 @@ ;; - Change the target of symbolic links. ;; ;; - Change the permission bits of the filenames (in systems with a -;; working unix-alike `dired-chmod-program'). See and customize the -;; variable `wdired-allow-to-change-permissions'. To change a single -;; char (toggling between its two more usual values) you can press -;; the space bar over it or left-click the mouse. To set any char to -;; an specific value (this includes the SUID, SGID and STI bits) you +;; working unix-alike "chmod"). See and customize the variable +;; `wdired-allow-to-change-permissions'. To change a single char +;; (toggling between its two more usual values), you can press the +;; space bar over it or left-click the mouse. To set any char to a +;; specific value (this includes the SUID, SGID and STI bits) you ;; can use the key labeled as the letter you want. Please note that ;; permissions of the links cannot be changed in that way, because ;; the change would affect to their targets, and this would not be @@ -58,18 +58,14 @@ ;; ;; - Mark files for deletion, by deleting their whole filename. -;;; Usage: +;; * Usage: -;; You can edit the names of the files by typing C-x C-q or by -;; executing M-x wdired-change-to-wdired-mode. Use C-c C-c when -;; finished or C-c C-k to abort. While editing filenames, a new -;; submenu "WDired" is available at top level. You can customize the -;; behavior of this package from this menu. - -;;; Change Log: - -;; Previous versions with complete changelogs were posted to -;; gnu.emacs.sources. +;; You can edit the names of the files by typing `C-x C-q' or +;; `M-x wdired-change-to-wdired-mode'. Use `C-c C-c' when +;; finished or `C-c C-k' to abort. +;; +;; You can customize the behavior of this package from the "WDired" +;; menu or with `M-x customize-group RET wdired RET'. ;;; Code: @@ -127,8 +123,8 @@ If `advanced', the bits are freely editable. You can use newlines), but if you want your changes to be useful, you better put a intelligible value. -Anyway, the real change of the permissions is done by the external -program `dired-chmod-program', which must exist." +The real change of the permissions is done by the external +program \"chmod\", which must exist." :type '(choice (const :tag "Not allowed" nil) (const :tag "Toggle/set bits" t) (other :tag "Bits freely editable" advanced))) @@ -537,15 +533,28 @@ non-nil means return old filename." (wdired-change-to-dired-mode) (if changes (progn - ;; If we are displaying a single file (rather than the - ;; contents of a directory), change dired-directory if that - ;; file was renamed. (This ought to be generalized to - ;; handle the multiple files case, but that's less trivial). - (when (and (stringp dired-directory) - (not (file-directory-p dired-directory)) - (null some-file-names-unchanged) - (= (length files-renamed) 1)) - (setq dired-directory (cdr (car files-renamed)))) + (cond + ((and (stringp dired-directory) + (not (file-directory-p dired-directory)) + (null some-file-names-unchanged) + (= (length files-renamed) 1)) + ;; If we are displaying a single file (rather than the + ;; contents of a directory), change dired-directory if that + ;; file was renamed. + (setq dired-directory (cdr (car files-renamed)))) + ((and (consp dired-directory) + (cdr dired-directory) + files-renamed) + ;; Fix dired buffers created with + ;; (dired '(foo f1 f2 f3)). + (setq dired-directory + (cons (car dired-directory) + ;; Replace in `dired-directory' files that have + ;; been modified with their new name keeping + ;; the ones that are unmodified at the same place. + (cl-loop for f in (cdr dired-directory) + collect (or (assoc-default f files-renamed) + f)))))) ;; Re-sort the buffer. (revert-buffer) (let ((inhibit-read-only t)) diff --git a/lisp/window.el b/lisp/window.el index 4d88ffa9039..ec2b0a69302 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9044,10 +9044,7 @@ in some window." ;; vertical-motion returns a number that is 1 larger than it ;; should. We need to fix that. (setq end-invisible-p - (and (or truncate-lines - (and (natnump truncate-partial-width-windows) - (< (window-total-width window) - truncate-partial-width-windows))) + (and (or truncate-lines (truncated-partial-width-window-p window)) (save-excursion (goto-char finish) (> (- (current-column) (window-hscroll window)) @@ -10449,7 +10446,7 @@ Otherwise, consult the value of `truncate-partial-width-windows' (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows (window-buffer window)))) (if (integerp t-p-w-w) - (< (window-width window) t-p-w-w) + (< (window-total-width window) t-p-w-w) t-p-w-w)))) diff --git a/lisp/winner.el b/lisp/winner.el index 38ab5f51016..89f337170cc 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -217,8 +217,7 @@ You may want to include buffer names such as *Help*, *Apropos*, ((window-minibuffer-p) (other-window 1))) (when (/= minisize (window-height miniwin)) (with-selected-window miniwin - (setf (window-height) minisize))))) - + (enlarge-window (- minisize (window-height))))))) (defvar winner-point-alist nil) diff --git a/lisp/xdg.el b/lisp/xdg.el index c7d9c0e785e..dd0d51290dc 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -250,7 +250,7 @@ This should be called at the beginning of a line." ;; Filter localized strings ((looking-at (rx (group-n 1 (+ (in alnum "-"))) (* blank) "["))) (t (error "Malformed line: %s" - (buffer-substring (point) (point-at-eol))))) + (buffer-substring (point) (line-end-position))))) (forward-line)) res)) @@ -265,7 +265,7 @@ Optional argument GROUP defaults to the string \"Desktop Entry\"." (forward-line)) (unless (looking-at xdg-desktop-group-regexp) (error "Expected group name! Instead saw: %s" - (buffer-substring (point) (point-at-eol)))) + (buffer-substring (point) (line-end-position)))) (when group (while (and (re-search-forward xdg-desktop-group-regexp nil t) (not (equal (match-string 1) group))))) diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c index d17acae728b..b09795ec38c 100644 --- a/lwlib/lwlib-Xaw.c +++ b/lwlib/lwlib-Xaw.c @@ -594,6 +594,8 @@ make_dialog (char* name, int nr_xft_data = left_buttons + right_buttons + 1; instance->xft_data = calloc (nr_xft_data + 1, sizeof(*instance->xft_data)); + if (!instance->xft_data) + memory_full ((nr_xft_data + 1) * sizeof *instance->xft_data); fill_xft_data (&instance->xft_data[0], w, xft_font); XtAddCallback (dialog, XtNdestroyCallback, destroy_xft_data, diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 30911d1581a..8a5daa230e3 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -313,7 +313,8 @@ AC_DEFUN([gl_COMMON_BODY], [ #else # define _GL_ATTRIBUTE_MAYBE_UNUSED _GL_ATTRIBUTE_UNUSED #endif -/* Alternative spelling of this macro, for convenience. */ +/* Alternative spelling of this macro, for convenience and for + compatibility with glibc/include/libc-symbols.h. */ #define _GL_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED /* Earlier spellings of this macro. */ #define _UNUSED_PARAMETER_ _GL_ATTRIBUTE_MAYBE_UNUSED diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index fb5f1b52a43..0c43dde716c 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -171,6 +171,7 @@ AC_DEFUN([gl_EARLY], # Code from module stat-time: # Code from module std-gnu11: # Code from module stdalign: + # Code from module stdckdint: # Code from module stddef: # Code from module stdint: # Code from module stdio: @@ -631,6 +632,7 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4=false gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false gl_gnulib_enabled_scratch_buffer=false + gl_gnulib_enabled_stdckdint=false gl_gnulib_enabled_strtoll=false gl_gnulib_enabled_utimens=false gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false @@ -743,6 +745,9 @@ AC_DEFUN([gl_INIT], if test $HAVE_GROUP_MEMBER = 0; then func_gl_gnulib_m4code_d3b2383720ee0e541357aa2aac598e2b fi + if test $HAVE_GROUP_MEMBER = 0; then + func_gl_gnulib_m4code_stdckdint + fi fi } func_gl_gnulib_m4code_lchmod () @@ -880,6 +885,20 @@ AC_DEFUN([gl_INIT], func_gl_gnulib_m4code_61bcaca76b3e6f9ae55d57a1c3193bc4 fi } + func_gl_gnulib_m4code_stdckdint () + { + if ! $gl_gnulib_enabled_stdckdint; then + AC_CHECK_HEADERS_ONCE([stdckdint.h]) + if test $ac_cv_header_stdckdint_h = yes; then + GL_GENERATE_STDCKDINT_H=false + else + GL_GENERATE_STDCKDINT_H=true + fi + gl_CONDITIONAL_HEADER([stdckdint.h]) + AC_PROG_MKDIR_P + gl_gnulib_enabled_stdckdint=true + fi + } func_gl_gnulib_m4code_strtoll () { if ! $gl_gnulib_enabled_strtoll; then @@ -1006,6 +1025,7 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_61bcaca76b3e6f9ae55d57a1c3193bc4], [$gl_gnulib_enabled_61bcaca76b3e6f9ae55d57a1c3193bc4]) AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c]) AM_CONDITIONAL([gl_GNULIB_ENABLED_scratch_buffer], [$gl_gnulib_enabled_scratch_buffer]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_stdckdint], [$gl_gnulib_enabled_stdckdint]) AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll]) AM_CONDITIONAL([gl_GNULIB_ENABLED_utimens], [$gl_gnulib_enabled_utimens]) AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec]) @@ -1277,6 +1297,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/idx.h lib/ieee754.in.h lib/ignore-value.h + lib/intprops-internal.h lib/intprops.h lib/inttypes.in.h lib/lchmod.c @@ -1349,6 +1370,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/stat-time.c lib/stat-time.h lib/stdalign.in.h + lib/stdckdint.in.h lib/stddef.in.h lib/stdint.in.h lib/stdio-impl.h diff --git a/m4/largefile.m4 b/m4/largefile.m4 index 3e8b5e39a72..ec9677c46d2 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 @@ -10,8 +10,10 @@ # It does not set _LARGEFILE_SOURCE=1 on HP-UX/ia64 32-bit, although this # setting of _LARGEFILE_SOURCE is needed so that <stdio.h> declares fseeko # and ftello in C++ mode as well. +# Fixed in Autoconf 2.72, which has AC_SYS_YEAR2038. AC_DEFUN([gl_SET_LARGEFILE_SOURCE], [ + m4_ifndef([AC_SYS_YEAR2038], [ AC_REQUIRE([AC_CANONICAL_HOST]) AC_FUNC_FSEEKO case "$host_os" in @@ -20,9 +22,10 @@ AC_DEFUN([gl_SET_LARGEFILE_SOURCE], [Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2).]) ;; esac + ]) ]) -# Work around a problem in Autoconf through at least 2.71 on glibc 2.34+ +# Work around a problem in Autoconf through 2.71 on glibc 2.34+ # with _TIME_BITS. Also, work around a problem in autoconf <= 2.69: # AC_SYS_LARGEFILE does not configure for large inodes on Mac OS X 10.5, # or configures them incorrectly in some cases. @@ -43,6 +46,7 @@ m4_define([_AC_SYS_LARGEFILE_TEST_INCLUDES], ]) ])# m4_version_prereq 2.70 +m4_ifndef([AC_SYS_YEAR2038], [ # _AC_SYS_LARGEFILE_MACRO_VALUE(C-MACRO, VALUE, # CACHE-VAR, @@ -118,6 +122,7 @@ AS_IF([test "$enable_largefile" != no], [64], [gl_YEAR2038_BODY([])])]) ])# AC_SYS_LARGEFILE +])# m4_ifndef AC_SYS_YEAR2038 # Enable large files on systems where this is implemented by Gnulib, not by the # system headers. diff --git a/m4/year2038.m4 b/m4/year2038.m4 index 06db589ba91..2e4427e6fac 100644 --- a/m4/year2038.m4 +++ b/m4/year2038.m4 @@ -1,4 +1,4 @@ -# year2038.m4 serial 7 +# year2038.m4 serial 8 dnl Copyright (C) 2017-2022 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -7,6 +7,12 @@ dnl with or without modifications, as long as this notice is preserved. dnl Attempt to ensure that 'time_t' can go past the year 2038 and that dnl the functions 'time', 'stat', etc. work with post-2038 timestamps. +m4_ifdef([AC_SYS_YEAR2038], [ + AC_DEFUN([gl_YEAR2038_EARLY]) + AC_DEFUN([gl_YEAR2038], [AC_SYS_YEAR2038]) + AC_DEFUN([gl_YEAR2038_BODY], [_AC_SYS_YEAR2038]) +], [ + AC_DEFUN([gl_YEAR2038_EARLY], [ AC_REQUIRE([AC_CANONICAL_HOST]) @@ -122,3 +128,5 @@ AC_DEFUN([gl_YEAR2038], [ gl_YEAR2038_BODY([require-year2038-safe]) ]) + +]) # m4_ifndef AC_SYS_YEAR2038 diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 9847e710c0f..79430bbaf1d 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -333,6 +333,7 @@ s/@PACKAGE@/emacs/ /^LIMITS_H *=/s/@[^@\n]*@/limits.h/ /^IEEE754_H *=/s/@[^@\n]*@/ieee754.h/ /^STDALIGN_H *=/s/@[^@\n]*@/stdalign.h/ +/^STDCKDINT_H *=/s/@[^@\n]*@/stdckdint.h/ /^STDDEF_H *=/s/@[^@\n]*@/stddef.h/ /^STDINT_H *=/s/@[^@\n]*@/stdint.h/ /^SYS_TIME_H_DEFINES_STRUCT_TIMESPEC *=/s/@[^@\n]*@/0/ @@ -424,6 +425,7 @@ s/= @GL_GENERATE_LIMITS_H_CONDITION@/= / s/= @GL_GENERATE_GMP_H_CONDITION@/= 1/ s/= @GL_GENERATE_GMP_GMP_H_CONDITION@/= / s/= @GL_GENERATE_MINI_GMP_H_CONDITION@/= 1/ +s/= @GL_GENERATE_STDCKDINT_H_CONDITION@/= 1/ s/= @GL_COND_OBJ_STDIO_READ_CONDITION@/= / s/= @GL_COND_OBJ_STDIO_WRITE_CONDITION@/= / s/\$\(MKDIR_P\) malloc// diff --git a/src/alloc.c b/src/alloc.c index 6e166d00d5b..34bedac36ba 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5314,6 +5314,7 @@ static void * pure_alloc (size_t size, int type) { void *result; + static bool pure_overflow_warned = false; again: if (type >= 0) @@ -5338,6 +5339,12 @@ pure_alloc (size_t size, int type) if (pure_bytes_used <= pure_size) return result; + if (!pure_overflow_warned) + { + message ("Pure Lisp storage overflowed"); + pure_overflow_warned = true; + } + /* Don't allocate a large amount here, because it might get mmap'd and then its address might not be usable. */ @@ -5355,9 +5362,6 @@ pure_alloc (size_t size, int type) goto again; } - -#ifdef HAVE_UNEXEC - /* Print a warning if PURESIZE is too small. */ void @@ -5368,8 +5372,6 @@ check_pure_size (void) " bytes needed)"), pure_bytes_used + pure_bytes_used_before_overflow); } -#endif - /* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from the non-Lisp data pool of the pure storage, and return its start diff --git a/src/buffer.c b/src/buffer.c index 4fd5b2be3e9..d4a0c37bed5 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -597,6 +597,7 @@ even if it is dead. The return value is never nil. */) set_buffer_intervals (b, NULL); BUF_UNCHANGED_MODIFIED (b) = 1; BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1; + BUF_CHARS_UNCHANGED_MODIFIED (b) = 1; BUF_END_UNCHANGED (b) = 0; BUF_BEG_UNCHANGED (b) = 0; *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */ diff --git a/src/buffer.h b/src/buffer.h index 47b4bdf749b..cbdbae798ba 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -149,12 +149,18 @@ enum { BEG = 1, BEG_BYTE = BEG }; #define BUF_BEG_UNCHANGED(buf) ((buf)->text->beg_unchanged) #define BUF_END_UNCHANGED(buf) ((buf)->text->end_unchanged) +#define BUF_CHARS_UNCHANGED_MODIFIED(buf) \ + ((buf)->text->chars_unchanged_modified) + #define UNCHANGED_MODIFIED \ BUF_UNCHANGED_MODIFIED (current_buffer) #define OVERLAY_UNCHANGED_MODIFIED \ BUF_OVERLAY_UNCHANGED_MODIFIED (current_buffer) #define BEG_UNCHANGED BUF_BEG_UNCHANGED (current_buffer) #define END_UNCHANGED BUF_END_UNCHANGED (current_buffer) + +#define CHARS_UNCHANGED_MODIFIED \ + BUF_CHARS_UNCHANGED_MODIFIED (current_buffer) /* Functions to set PT in the current buffer, or another buffer. */ @@ -268,6 +274,11 @@ struct buffer_text end_unchanged contain no useful information. */ modiff_count overlay_unchanged_modified; + /* CHARS_MODIFF as of last redisplay that finished. It's used + when we only care about changes in actual buffer text, not in + any other kind of changes, like properties etc. */ + modiff_count chars_unchanged_modified; + /* Properties of this buffer's text. */ INTERVAL intervals; diff --git a/src/callproc.c b/src/callproc.c index e8e4c48b5be..2d457b3c84c 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1574,7 +1574,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, #endif /* not DONT_REOPEN_PTY */ #ifdef SETUP_SLAVE_PTY - if (pty_flag) + if (pty_in && std_in >= 0) { SETUP_SLAVE_PTY; } diff --git a/src/charset.c b/src/charset.c index 9edbd4c8c84..bb59262fe98 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1852,9 +1852,8 @@ although this usage is obsolescent. */) DEFUN ("encode-char", Fencode_char, Sencode_char, 2, 2, 0, doc: /* Encode the character CH into a code-point of CHARSET. -Return the encoded code-point, a fixnum if its value is small enough, -otherwise a bignum. -Return nil if CHARSET doesn't support CH. */) +Return the encoded code-point as an integer, +or nil if CHARSET doesn't support CH. */) (Lisp_Object ch, Lisp_Object charset) { int c, id; diff --git a/src/comp.c b/src/comp.c index 21d2ee5300b..70e7d5a8bbf 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5017,8 +5017,6 @@ helper_GET_SYMBOL_WITH_POSITION (Lisp_Object a) /* `native-comp-eln-load-path' clean-up support code. */ -static Lisp_Object all_loaded_comp_units_h; - #ifdef WINDOWSNT static Lisp_Object return_nil (Lisp_Object arg) @@ -5060,11 +5058,12 @@ eln_load_path_final_clean_up (void) } /* This function puts the compilation unit in the - `all_loaded_comp_units_h` hashmap. */ + `Vcomp_loaded_comp_units_h` hashmap. */ static void register_native_comp_unit (Lisp_Object comp_u) { - Fputhash (XNATIVE_COMP_UNIT (comp_u)->file, comp_u, all_loaded_comp_units_h); + Fputhash ( + XNATIVE_COMP_UNIT (comp_u)->file, comp_u, Vcomp_loaded_comp_units_h); } @@ -5552,7 +5551,7 @@ LATE_LOAD has to be non-nil when loading for deferred compilation. */) struct Lisp_Native_Comp_Unit *comp_u = allocate_native_comp_unit (); Lisp_Object encoded_filename = ENCODE_FILE (filename); - if (!NILP (Fgethash (filename, all_loaded_comp_units_h, Qnil)) + if (!NILP (Fgethash (filename, Vcomp_loaded_comp_units_h, Qnil)) && !file_in_eln_sys_dir (filename) && !NILP (Ffile_writable_p (filename))) { @@ -5754,10 +5753,6 @@ compiled one. */); staticpro (&loadsearch_re_list); loadsearch_re_list = Qnil; - staticpro (&all_loaded_comp_units_h); - all_loaded_comp_units_h = - CALLN (Fmake_hash_table, QCweakness, Qkey_and_value, QCtest, Qequal); - DEFVAR_LISP ("comp-ctxt", Vcomp_ctxt, doc: /* The compiler context. */); Vcomp_ctxt = Qnil; @@ -5817,6 +5812,12 @@ For internal use. */); doc: /* When non-nil assume the file being compiled to be preloaded. */); + DEFVAR_LISP ("comp-loaded-comp-units-h", Vcomp_loaded_comp_units_h, + doc: /* Hash table recording all loaded compilation units. +file -> CU. */); + Vcomp_loaded_comp_units_h = + CALLN (Fmake_hash_table, QCweakness, Qvalue, QCtest, Qequal); + Fprovide (intern_c_string ("native-compile"), Qnil); #endif /* #ifdef HAVE_NATIVE_COMP */ diff --git a/src/dispextern.h b/src/dispextern.h index 12ba927261f..2f5f4335fe5 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2874,18 +2874,17 @@ typedef struct { INLINE void reset_mouse_highlight (Mouse_HLInfo *hlinfo) { - - hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; - hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; - hlinfo->mouse_face_mouse_x = hlinfo->mouse_face_mouse_y = 0; - hlinfo->mouse_face_beg_x = hlinfo->mouse_face_end_x = 0; - hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; - hlinfo->mouse_face_mouse_frame = NULL; - hlinfo->mouse_face_window = Qnil; - hlinfo->mouse_face_overlay = Qnil; - hlinfo->mouse_face_past_end = false; - hlinfo->mouse_face_hidden = false; - hlinfo->mouse_face_defer = false; + hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; + hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; + hlinfo->mouse_face_mouse_x = hlinfo->mouse_face_mouse_y = 0; + hlinfo->mouse_face_beg_x = hlinfo->mouse_face_end_x = 0; + hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; + hlinfo->mouse_face_mouse_frame = NULL; + hlinfo->mouse_face_window = Qnil; + hlinfo->mouse_face_overlay = Qnil; + hlinfo->mouse_face_past_end = false; + hlinfo->mouse_face_hidden = false; + hlinfo->mouse_face_defer = false; } /*********************************************************************** diff --git a/src/editfns.c b/src/editfns.c index 07f5c0bbef7..cd5cddee79f 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -709,9 +709,28 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */) } -DEFUN ("line-beginning-position", - Fline_beginning_position, Sline_beginning_position, 0, 1, 0, - doc: /* Return the character position of the first character on the current line. +static ptrdiff_t +bol (Lisp_Object n, ptrdiff_t *out_count) +{ + ptrdiff_t bytepos, charpos, count; + + if (NILP (n)) + count = 0; + else if (FIXNUMP (n)) + count = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n) - 1, BUF_BYTES_MAX); + else + { + CHECK_INTEGER (n); + count = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX; + } + if (out_count) + *out_count = count; + scan_newline_from_point (count, &charpos, &bytepos); + return charpos; +} + +DEFUN ("pos-bol", Fpos_bol, Spos_bol, 0, 1, 0, + doc: /* Return the position of the first character on the current line. With optional argument N, scan forward N - 1 lines first. If the scan reaches the end of the buffer, return that position. @@ -720,6 +739,17 @@ position of the first character in logical order, i.e. the smallest character position on the logical line. See `vertical-motion' for movement by screen lines. +This function does not move point. Also see `line-beginning-position'. */) + (Lisp_Object n) +{ + return make_fixnum (bol (n, NULL)); +} + +DEFUN ("line-beginning-position", + Fline_beginning_position, Sline_beginning_position, 0, 1, 0, + doc: /* Return the position of the first character in the current line/field. +This function is like `pos-bol' (which see), but respects fields. + This function constrains the returned position to the current field unless that position would be on a different line from the original, unconstrained result. If N is nil or 1, and a front-sticky field @@ -729,28 +759,33 @@ boundaries, bind `inhibit-field-text-motion' to t. This function does not move point. */) (Lisp_Object n) { - ptrdiff_t charpos, bytepos, count; + ptrdiff_t count, charpos = bol (n, &count); + /* Return END constrained to the current input field. */ + return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT), + count != 0 ? Qt : Qnil, + Qt, Qnil); +} + +static ptrdiff_t +eol (Lisp_Object n) +{ + ptrdiff_t count; if (NILP (n)) - count = 0; + count = 1; else if (FIXNUMP (n)) - count = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n) - 1, BUF_BYTES_MAX); + count = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n), BUF_BYTES_MAX); else { CHECK_INTEGER (n); count = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX; } - - scan_newline_from_point (count, &charpos, &bytepos); - - /* Return END constrained to the current input field. */ - return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT), - count != 0 ? Qt : Qnil, - Qt, Qnil); + return find_before_next_newline (PT, 0, count - (count <= 0), + NULL); } -DEFUN ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0, - doc: /* Return the character position of the last character on the current line. +DEFUN ("pos-eol", Fpos_eol, Spos_eol, 0, 1, 0, + doc: /* Return the position of the last character on the current line. With argument N not nil or 1, move forward N - 1 lines first. If scan reaches end of buffer, return that position. @@ -758,6 +793,19 @@ This function ignores text display directionality; it returns the position of the last character in logical order, i.e. the largest character position on the line. +This function does not move point. Also see `line-end-position'. */) + (Lisp_Object n) +{ + return make_fixnum (eol (n)); +} + +DEFUN ("line-end-position", Fline_end_position, Sline_end_position, 0, 1, 0, + doc: /* Return the position of the last character in the current line/field. +With argument N not nil or 1, move forward N - 1 lines first. +If scan reaches end of buffer, return that position. + +This function is like `pos-eol' (which see), but respects fields. + This function constrains the returned position to the current field unless that would be on a different line from the original, unconstrained result. If N is nil or 1, and a rear-sticky field ends @@ -767,24 +815,8 @@ boundaries bind `inhibit-field-text-motion' to t. This function does not move point. */) (Lisp_Object n) { - ptrdiff_t clipped_n; - ptrdiff_t end_pos; - ptrdiff_t orig = PT; - - if (NILP (n)) - clipped_n = 1; - else if (FIXNUMP (n)) - clipped_n = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n), BUF_BYTES_MAX); - else - { - CHECK_INTEGER (n); - clipped_n = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX; - } - end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0), - NULL); - /* Return END_POS constrained to the current input field. */ - return Fconstrain_to_field (make_fixnum (end_pos), make_fixnum (orig), + return Fconstrain_to_field (make_fixnum (eol (n)), make_fixnum (PT), Qnil, Qt, Qnil); } @@ -1172,8 +1204,7 @@ This ignores the environment variables LOGNAME and USER, so it differs from } DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0, - doc: /* Return the effective uid of Emacs. -Value is a fixnum, if it's small enough, otherwise a bignum. */) + doc: /* Return the effective uid of Emacs, as an integer. */) (void) { uid_t euid = geteuid (); @@ -1181,8 +1212,7 @@ Value is a fixnum, if it's small enough, otherwise a bignum. */) } DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0, - doc: /* Return the real uid of Emacs. -Value is a fixnum, if it's small enough, otherwise a bignum. */) + doc: /* Return the real uid of Emacs, as an integer. */) (void) { uid_t uid = getuid (); @@ -1208,8 +1238,7 @@ Return nil if a group with such GID does not exists or is not known. */) } DEFUN ("group-gid", Fgroup_gid, Sgroup_gid, 0, 0, 0, - doc: /* Return the effective gid of Emacs. -Value is a fixnum, if it's small enough, otherwise a bignum. */) + doc: /* Return the effective gid of Emacs, as an integer. */) (void) { gid_t egid = getegid (); @@ -1217,8 +1246,7 @@ Value is a fixnum, if it's small enough, otherwise a bignum. */) } DEFUN ("group-real-gid", Fgroup_real_gid, Sgroup_real_gid, 0, 0, 0, - doc: /* Return the real gid of Emacs. -Value is a fixnum, if it's small enough, otherwise a bignum. */) + doc: /* Return the real gid of Emacs, as an integer. */) (void) { gid_t gid = getgid (); @@ -1306,8 +1334,7 @@ DEFUN ("system-name", Fsystem_name, Ssystem_name, 0, 0, 0, } DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0, - doc: /* Return the process ID of Emacs, as a number. -Value is a fixnum, if it's small enough, otherwise a bignum. */) + doc: /* Return the process ID of Emacs, as an integer. */) (void) { pid_t pid = getpid (); @@ -4615,6 +4642,8 @@ with an optional argument LOCK non-nil. */); defsubr (&Sline_beginning_position); defsubr (&Sline_end_position); + defsubr (&Spos_bol); + defsubr (&Spos_eol); defsubr (&Ssave_excursion); defsubr (&Ssave_current_buffer); diff --git a/src/font.c b/src/font.c index 3846cfc1079..8acedb9bf88 100644 --- a/src/font.c +++ b/src/font.c @@ -4691,8 +4691,7 @@ Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID), where VARIATION-SELECTOR is a character code of variation selector (#xFE00..#xFE0F or #xE0100..#xE01EF). - GLYPH-ID is a glyph code of the corresponding variation glyph, -a fixnum, if it's small enough, otherwise a bignum. */) + GLYPH-ID is a glyph code of the corresponding variation glyph, an integer. */) (Lisp_Object font_object, Lisp_Object character) { unsigned variations[256]; @@ -4729,8 +4728,7 @@ a fixnum, if it's small enough, otherwise a bignum. */) that apply to POSITION. POSITION may be nil, in which case, FONT-SPEC is the font for displaying the character CH with the default face. GLYPH-CODE is the glyph code in the font to use for - the character, it is a fixnum, if it is small enough, otherwise a - bignum. + the character, as an integer. For a text terminal, return a nonnegative integer glyph code for the character, or a negative integer if the character is not diff --git a/src/haikuterm.c b/src/haikuterm.c index c2d4e34ba25..df1c39974f8 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -1252,6 +1252,8 @@ haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s) ? CHAR_TABLE_REF (Vglyphless_char_display, glyph->u.glyphless.ch) : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (CONSP (acronym)) + acronym = XCAR (acronym); if (STRINGP (acronym)) str = SSDATA (acronym); } diff --git a/src/indent.c b/src/indent.c index cb368024d97..aa905f387bb 100644 --- a/src/indent.c +++ b/src/indent.c @@ -577,12 +577,15 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, if (!NILP (BVAR (current_buffer, truncate_lines))) lines_truncated = true; - else if (w && FIXNUMP (Vtruncate_partial_width_windows)) - lines_truncated = - w->total_cols < XFIXNAT (Vtruncate_partial_width_windows); - else if (w && !NILP (Vtruncate_partial_width_windows)) - lines_truncated = - w->total_cols < FRAME_COLS (XFRAME (WINDOW_FRAME (w))); + else if (!NILP (Vtruncate_partial_width_windows) && w + && w->total_cols < FRAME_COLS (XFRAME (WINDOW_FRAME (w)))) + { + if (FIXNUMP (Vtruncate_partial_width_windows)) + lines_truncated = + w->total_cols < XFIXNAT (Vtruncate_partial_width_windows); + else + lines_truncated = true; + } /* Special optimization for buffers with long and truncated lines: assumes that each character is a single column. */ if (lines_truncated) diff --git a/src/nsfns.m b/src/nsfns.m index 1d3dcd31243..2699cf37a5b 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1727,7 +1727,7 @@ Optional arg DIR, if non-nil, supplies a default directory. Optional arg MUSTMATCH, if non-nil, means the returned file or directory must exist. Optional arg INIT, if non-nil, provides a default file name to use. -Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */) +Optional arg DIR-ONLY-P, if non-nil, means choose only directories. */) (Lisp_Object prompt, Lisp_Object dir, Lisp_Object mustmatch, Lisp_Object init, Lisp_Object dir_only_p) { diff --git a/src/nsterm.m b/src/nsterm.m index e3f47eb905e..6c6151701b8 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4241,6 +4241,8 @@ ns_draw_glyphless_glyph_string_foreground (struct glyph_string *s) ? CHAR_TABLE_REF (Vglyphless_char_display, glyph->u.glyphless.ch) : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (CONSP (acronym)) + acronym = XCAR (acronym); if (STRINGP (acronym)) str = SSDATA (acronym); } diff --git a/src/pdumper.c b/src/pdumper.c index 33cb804dbae..903298f17d2 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2764,6 +2764,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) DUMP_FIELD_COPY (out, buffer, own_text.end_unchanged); DUMP_FIELD_COPY (out, buffer, own_text.unchanged_modified); DUMP_FIELD_COPY (out, buffer, own_text.overlay_unchanged_modified); + DUMP_FIELD_COPY (out, buffer, own_text.chars_unchanged_modified); if (buffer->own_text.intervals) dump_field_fixup_later (ctx, out, buffer, &buffer->own_text.intervals); dump_field_lv_rawptr (ctx, out, buffer, &buffer->own_text.markers, @@ -2910,6 +2911,9 @@ static dump_off dump_native_comp_unit (struct dump_context *ctx, struct Lisp_Native_Comp_Unit *comp_u) { + if (!CONSP (comp_u->file)) + error ("Trying to dump non fixed-up eln file"); + /* Have function documentation always lazy loaded to optimize load-time. */ comp_u->data_fdoc_v = Qnil; START_DUMP_PVEC (ctx, &comp_u->header, struct Lisp_Native_Comp_Unit, out); @@ -4040,6 +4044,8 @@ types. */) if (!NILP (XCDR (Fall_threads ()))) error ("No other Lisp threads can be running when this function is called"); + check_pure_size (); + /* Clear out any detritus in memory. */ do { diff --git a/src/pgtkselect.c b/src/pgtkselect.c index e0230003b3a..212bbd56aa4 100644 --- a/src/pgtkselect.c +++ b/src/pgtkselect.c @@ -1248,8 +1248,7 @@ pgtk_get_window_property_as_lisp_data (struct pgtk_display_info *dpyinfo, ATOM 32 > 1 Vector of Symbols * 16 1 Integer * 16 > 1 Vector of Integers - * 32 1 if small enough: fixnum - otherwise: bignum + * 32 1 Integer * 32 > 1 Vector of the above When converting an object to C, it may be of the form (SYMBOL diff --git a/src/pgtkterm.c b/src/pgtkterm.c index b283cef7cde..491ba338821 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -1584,6 +1584,8 @@ pgtk_draw_glyphless_glyph_string_foreground (struct glyph_string *s) ? CHAR_TABLE_REF (Vglyphless_char_display, glyph->u.glyphless.ch) : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (CONSP (acronym)) + acronym = XCAR (acronym); if (STRINGP (acronym)) str = SSDATA (acronym); } diff --git a/src/process.c b/src/process.c index 23479c06194..7a133cda00f 100644 --- a/src/process.c +++ b/src/process.c @@ -1209,8 +1209,8 @@ If PROCESS has not yet exited or died, return 0. */) DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, doc: /* Return the process id of PROCESS. -This is the pid of the external process which PROCESS uses or talks to. -It is a fixnum if the value is small enough, otherwise a bignum. +This is the pid of the external process which PROCESS uses or talks to, +an integer. For a network, serial, and pipe connections, this value is nil. */) (register Lisp_Object process) { @@ -7773,46 +7773,6 @@ DEFUN ("process-coding-system", XPROCESS (process)->encode_coding_system); } -DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte, - Sset_process_filter_multibyte, 2, 2, 0, - doc: /* Set multibyteness of the strings given to PROCESS's filter. -If FLAG is non-nil, the filter is given multibyte strings. -If FLAG is nil, the filter is given unibyte strings. In this case, -all character code conversion except for end-of-line conversion is -suppressed. */) - (Lisp_Object process, Lisp_Object flag) -{ - CHECK_PROCESS (process); - - struct Lisp_Process *p = XPROCESS (process); - if (NILP (flag)) - pset_decode_coding_system - (p, raw_text_coding_system (p->decode_coding_system)); - - /* If the sockets haven't been set up yet, the final setup part of - this will be called asynchronously. */ - if (p->infd < 0 || p->outfd < 0) - return Qnil; - - setup_process_coding_systems (process); - - return Qnil; -} - -DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p, - Sprocess_filter_multibyte_p, 1, 1, 0, - doc: /* Return t if a multibyte string is given to PROCESS's filter.*/) - (Lisp_Object process) -{ - CHECK_PROCESS (process); - struct Lisp_Process *p = XPROCESS (process); - if (p->infd < 0) - return Qnil; - eassert (p->infd < FD_SETSIZE); - struct coding_system *coding = proc_decode_coding_system[p->infd]; - return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt); -} - @@ -8808,8 +8768,6 @@ sentinel or a process filter function has an error. */); defsubr (&Sinternal_default_process_filter); defsubr (&Sset_process_coding_system); defsubr (&Sprocess_coding_system); - defsubr (&Sset_process_filter_multibyte); - defsubr (&Sprocess_filter_multibyte_p); { Lisp_Object subfeatures = Qnil; diff --git a/src/term.c b/src/term.c index 3bea621dbda..2e43d89232f 100644 --- a/src/term.c +++ b/src/term.c @@ -1862,12 +1862,24 @@ produce_glyphless_glyph (struct it *it, Lisp_Object acronym) acronym = CHAR_TABLE_REF (Vglyphless_char_display, it->c); if (CONSP (acronym)) acronym = XCDR (acronym); - buf[0] = '['; str = STRINGP (acronym) ? SSDATA (acronym) : ""; - for (len = 0; len < 6 && str[len] && ASCII_CHAR_P (str[len]); len++) - buf[1 + len] = str[len]; - buf[1 + len] = ']'; - len += 2; + /* A special kludgey feature for single-character acronyms: + don't put them in a box, effectively treating them as a + replacement character. */ + if (STRINGP (acronym) && SCHARS (acronym) == 1) + { + buf[0] = str[0]; + len = 1; + } + else + { + buf[0] = '['; + for (len = 0; + len < 6 && str[len] && ASCII_CHAR_P (str[len]); len++) + buf[1 + len] = str[len]; + buf[1 + len] = ']'; + len += 2; + } } else { diff --git a/src/w32.c b/src/w32.c index cbcfcdd4f6d..44c279602cf 100644 --- a/src/w32.c +++ b/src/w32.c @@ -5992,12 +5992,22 @@ sys_umask (int mode) #ifndef SYMBOLIC_LINK_FLAG_DIRECTORY #define SYMBOLIC_LINK_FLAG_DIRECTORY 0x1 #endif +#ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE +#define SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE 0x2 +#endif int symlink (char const *filename, char const *linkname) { char linkfn[MAX_UTF8_PATH], *tgtfn; - DWORD flags = 0; + /* The SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE flag is + supported from Windows 10 build 14972. It is only supported if + Developer Mode is enabled, and is ignored if it isn't. */ + DWORD flags = + (os_subtype == OS_SUBTYPE_NT + && (w32_major_version > 10 + || (w32_major_version == 10 && w32_build_number >= 14972))) + ? SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE : 0; int dir_access, filename_ends_in_slash; /* Diagnostics follows Posix as much as possible. */ @@ -6055,7 +6065,7 @@ symlink (char const *filename, char const *linkname) directory. */ filename_ends_in_slash = IS_DIRECTORY_SEP (filename[strlen (filename) - 1]); if (dir_access == 0 || filename_ends_in_slash) - flags = SYMBOLIC_LINK_FLAG_DIRECTORY; + flags |= SYMBOLIC_LINK_FLAG_DIRECTORY; tgtfn = (char *)map_w32_filename (filename, NULL); if (filename_ends_in_slash) diff --git a/src/w32term.c b/src/w32term.c index d0577efccc1..dff21489e5b 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -1490,6 +1490,8 @@ w32_draw_glyphless_glyph_string_foreground (struct glyph_string *s) ? CHAR_TABLE_REF (Vglyphless_char_display, glyph->u.glyphless.ch) : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (CONSP (acronym)) + acronym = XCAR (acronym); if (STRINGP (acronym)) str = SSDATA (acronym); } diff --git a/src/window.c b/src/window.c index c8fcb3a607f..2bce4c9723d 100644 --- a/src/window.c +++ b/src/window.c @@ -556,7 +556,9 @@ select_window (Lisp_Object window, Lisp_Object norecord, frame is active. */ Fselect_frame (frame, norecord); /* Fselect_frame called us back so we've done all the work already. */ - eassert (EQ (window, selected_window)); + eassert (EQ (window, selected_window) + || (EQ (window, f->minibuffer_window) + && NILP (Fminibufferp (XWINDOW (window)->contents, Qt)))); return window; } else diff --git a/src/xdisp.c b/src/xdisp.c index 03c43be5bc0..70f6936dd0b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7842,15 +7842,14 @@ lookup_glyphless_char_display (int c, struct it *it) && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) >= 1) { if (c >= 0) - { - glyphless_method = CHAR_TABLE_REF (Vglyphless_char_display, c); - if (CONSP (glyphless_method)) - glyphless_method = FRAME_WINDOW_P (it->f) - ? XCAR (glyphless_method) - : XCDR (glyphless_method); - } + glyphless_method = CHAR_TABLE_REF (Vglyphless_char_display, c); else glyphless_method = XCHAR_TABLE (Vglyphless_char_display)->extras[0]; + + if (CONSP (glyphless_method)) + glyphless_method = FRAME_WINDOW_P (it->f) + ? XCAR (glyphless_method) + : XCDR (glyphless_method); } retry: @@ -17323,6 +17322,7 @@ mark_window_display_accurate_1 (struct window *w, bool accurate_p) BUF_UNCHANGED_MODIFIED (b) = BUF_MODIFF (b); BUF_OVERLAY_UNCHANGED_MODIFIED (b) = BUF_OVERLAY_MODIFF (b); + BUF_CHARS_UNCHANGED_MODIFIED (b) = BUF_CHARS_MODIFF (b); BUF_BEG_UNCHANGED (b) = BUF_GPT (b) - BUF_BEG (b); BUF_END_UNCHANGED (b) = BUF_Z (b) - BUF_GPT (b); @@ -19585,7 +19585,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Check whether the buffer to be displayed contains long lines. */ if (!NILP (Vlong_line_threshold) && !current_buffer->long_line_optimizations_p - && MODIFF - UNCHANGED_MODIFIED > 8) + && CHARS_MODIFF - CHARS_UNCHANGED_MODIFIED > 8) { ptrdiff_t cur, next, found, max = 0, threshold; threshold = XFIXNUM (Vlong_line_threshold); @@ -37116,7 +37116,9 @@ GRAPHICAL and TEXT should each have one of the values listed above. The char-table has one extra slot to control the display of a character for which no font is found. This slot only takes effect on graphical terminals. Its value should be an ASCII acronym string, `hex-code', `empty-box', or -`thin-space'. The default is `empty-box'. +`thin-space'. It could also be a cons cell of any two of these, to specify +separate values for graphical and text terminals. +The default is `empty-box'. If a character has a non-nil entry in an active display table, the display table takes effect; in this case, Emacs does not consult diff --git a/src/xfaces.c b/src/xfaces.c index bbc1d352c6e..70d5cbeb4c7 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6012,8 +6012,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] #ifdef HAVE_WINDOW_SYSTEM struct face *default_face; struct frame *f; - Lisp_Object stipple, underline, overline, strike_through, box, temp_spec; - Lisp_Object temp_extra, antialias; + Lisp_Object stipple, underline, overline, strike_through, box; eassert (FRAME_WINDOW_P (cache->f)); @@ -6055,28 +6054,8 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] emacs_abort (); } if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])) - { - /* We want attrs to allow overriding most elements in the - spec (IOW, to start out as an empty font spec), but - preserve the antialiasing attribute. (bug#17973, - bug#37473). */ - temp_spec = Ffont_spec (0, NULL); - temp_extra = AREF (attrs[LFACE_FONT_INDEX], - FONT_EXTRA_INDEX); - /* If `:antialias' wasn't specified, keep it unspecified - instead of changing it to nil. */ - - if (CONSP (temp_extra)) - antialias = Fassq (QCantialias, temp_extra); - else - antialias = Qnil; - - if (FONTP (attrs[LFACE_FONT_INDEX]) && !NILP (antialias)) - Ffont_put (temp_spec, QCantialias, Fcdr (antialias)); - - attrs[LFACE_FONT_INDEX] - = font_load_for_lface (f, attrs, temp_spec); - } + attrs[LFACE_FONT_INDEX] + = font_load_for_lface (f, attrs, attrs[LFACE_FONT_INDEX]); if (FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])) { face->font = XFONT_OBJECT (attrs[LFACE_FONT_INDEX]); diff --git a/src/xfns.c b/src/xfns.c index a275e3e11a8..0b1f707e9fc 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -965,7 +965,7 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu } #endif -#if defined HAVE_XSYNC && !defined USE_GTK +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME /* Frame synchronization can't be used in child frames since they are not directly managed by the compositing manager. Re-enabling vsync in former child frames also leads to @@ -2421,7 +2421,7 @@ static void x_set_use_frame_synchronization (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { -#if !defined USE_GTK && defined HAVE_XSYNC +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME struct x_display_info *dpyinfo; dpyinfo = FRAME_DISPLAY_INFO (f); @@ -5156,7 +5156,8 @@ This function is an internal primitive--use `make-frame' instead. */) ((STRINGP (value) && !strcmp (SSDATA (value), "extended")) ? 2 : 1)); -#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK +#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK \ + && defined HAVE_CLOCK_GETTIME x_sync_init_fences (f); #endif #endif diff --git a/src/xmenu.c b/src/xmenu.c index 5b8a8f77a2d..1452b3c6d12 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -242,45 +242,52 @@ x_menu_translate_generic_event (XEvent *event) { eassert (!event->xcookie.data); - if (XGetEventData (dpyinfo->display, &event->xcookie)) + switch (event->xcookie.evtype) { - switch (event->xcookie.evtype) - { - case XI_ButtonPress: - case XI_ButtonRelease: - xev = (XIDeviceEvent *) event->xcookie.data; - copy.xbutton.type = (event->xcookie.evtype == XI_ButtonPress - ? ButtonPress : ButtonRelease); - copy.xbutton.serial = xev->serial; - copy.xbutton.send_event = xev->send_event; - copy.xbutton.display = dpyinfo->display; - copy.xbutton.window = xev->event; - copy.xbutton.root = xev->root; - copy.xbutton.subwindow = xev->child; - copy.xbutton.time = xev->time; - copy.xbutton.x = lrint (xev->event_x); - copy.xbutton.y = lrint (xev->event_y); - copy.xbutton.x_root = lrint (xev->root_x); - copy.xbutton.y_root = lrint (xev->root_y); - copy.xbutton.state = xi_convert_event_state (xev); - copy.xbutton.button = xev->detail; - copy.xbutton.same_screen = True; - - device = xi_device_from_id (dpyinfo, xev->deviceid); - - /* I don't know the repercussions of changing - device->grab on XI_ButtonPress events, so be safe and - only do what is necessary to prevent the grab from - being left invalid as XMenuActivate swallows - events. */ - if (device && xev->evtype == XI_ButtonRelease) - device->grab &= ~(1 << xev->detail); - - XPutBackEvent (dpyinfo->display, ©); - - break; - } + case XI_ButtonPress: + case XI_ButtonRelease: + + if (!XGetEventData (dpyinfo->display, &event->xcookie)) + break; + + xev = (XIDeviceEvent *) event->xcookie.data; + copy.xbutton.type = (event->xcookie.evtype == XI_ButtonPress + ? ButtonPress : ButtonRelease); + copy.xbutton.serial = xev->serial; + copy.xbutton.send_event = xev->send_event; + copy.xbutton.display = dpyinfo->display; + copy.xbutton.window = xev->event; + copy.xbutton.root = xev->root; + copy.xbutton.subwindow = xev->child; + copy.xbutton.time = xev->time; + copy.xbutton.x = lrint (xev->event_x); + copy.xbutton.y = lrint (xev->event_y); + copy.xbutton.x_root = lrint (xev->root_x); + copy.xbutton.y_root = lrint (xev->root_y); + copy.xbutton.state = xi_convert_event_state (xev); + copy.xbutton.button = xev->detail; + copy.xbutton.same_screen = True; + + device = xi_device_from_id (dpyinfo, xev->deviceid); + + /* I don't know the repercussions of changing + device->grab on XI_ButtonPress events, so be safe and + only do what is necessary to prevent the grab from + being left invalid as XMenuActivate swallows + events. */ + if (device && xev->evtype == XI_ButtonRelease) + device->grab &= ~(1 << xev->detail); + + XPutBackEvent (dpyinfo->display, ©); XFreeEventData (dpyinfo->display, &event->xcookie); + + break; + + case XI_HierarchyChanged: + case XI_DeviceChanged: + /* These events must always be handled. */ + x_dispatch_event (event, dpyinfo->display); + break; } } } @@ -2783,6 +2790,9 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, DEFER_SELECTIONS; XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f)); + /* When the input extension is in use, the owner_events grab will + report extension events on frames, which the XMenu library does + not normally understand. */ #ifdef HAVE_XINPUT2 XMenuActivateSetTranslateFunction (x_menu_translate_generic_event); #endif diff --git a/src/xml.c b/src/xml.c index 522efd224c6..2cccff12331 100644 --- a/src/xml.c +++ b/src/xml.c @@ -186,6 +186,12 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, xmlCheckVersion (LIBXML_VERSION); + if (NILP (start)) + start = Fpoint_min (); + + if (NILP (end)) + end = Fpoint_max (); + validate_region (&start, &end); istart = XFIXNUM (start); @@ -269,8 +275,11 @@ xml_cleanup_parser (void) DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region, Slibxml_parse_html_region, - 2, 4, 0, + 0, 4, 0, doc: /* Parse the region as an HTML document and return the parse tree. +If START is nil, it defaults to `point-min'. If END is nil, it +defaults to `point-max'. + If BASE-URL is non-nil, it is used to expand relative URLs. If you want comments to be stripped, use the `xml-remove-comments' @@ -284,8 +293,11 @@ function to strip comments before calling this function. */) DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region, Slibxml_parse_xml_region, - 2, 4, 0, + 0, 4, 0, doc: /* Parse the region as an XML document and return the parse tree. +If START is nil, it defaults to `point-min'. If END is nil, it +defaults to `point-max'. + If BASE-URL is non-nil, it is used to expand relative URLs. If you want comments to be stripped, use the `xml-remove-comments' diff --git a/src/xselect.c b/src/xselect.c index d6e6d0c30b8..bab0400540e 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -1754,8 +1754,7 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, ATOM 32 > 1 Vector of Symbols * 16 1 Integer * 16 > 1 Vector of Integers - * 32 1 if small enough: fixnum - otherwise: bignum + * 32 1 Integer * 32 > 1 Vector of the above When converting an object to C, it may be of the form (SYMBOL . <data>) diff --git a/src/xterm.c b/src/xterm.c index 7487450d649..7a0a21b1369 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -952,7 +952,7 @@ static const struct x_atom_ref x_atom_refs[] = ATOM_REFS_INIT ("MULTIPLE", Xatom_MULTIPLE) ATOM_REFS_INIT ("INCR", Xatom_INCR) ATOM_REFS_INIT ("_EMACS_TMP_", Xatom_EMACS_TMP) - ATOM_REFS_INIT ("EMACS_SERVER_TIME_PROP", Xatom_EMACS_SERVER_TIME_PROP) + ATOM_REFS_INIT ("_EMACS_SERVER_TIME_PROP", Xatom_EMACS_SERVER_TIME_PROP) ATOM_REFS_INIT ("TARGETS", Xatom_TARGETS) ATOM_REFS_INIT ("NULL", Xatom_NULL) ATOM_REFS_INIT ("ATOM", Xatom_ATOM) @@ -6655,7 +6655,7 @@ x_set_frame_alpha (struct frame *f) Starting and ending an update ***********************************************************************/ -#if defined HAVE_XSYNC && !defined USE_GTK +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME /* Wait for an event matching PREDICATE to show up in the event queue, or TIMEOUT to elapse. @@ -6714,9 +6714,9 @@ x_if_event (Display *dpy, XEvent *event_return, server timestamp TIMESTAMP. Return 0 if the necessary information is not available. */ -static uint64_t +static uint_fast64_t x_sync_get_monotonic_time (struct x_display_info *dpyinfo, - uint64_t timestamp) + uint_fast64_t timestamp) { if (dpyinfo->server_time_monotonic_p) return timestamp; @@ -6725,19 +6725,29 @@ x_sync_get_monotonic_time (struct x_display_info *dpyinfo, if (!dpyinfo->server_time_offset) return 0; - return timestamp - dpyinfo->server_time_offset; + uint_fast64_t t; + return (INT_SUBTRACT_WRAPV (timestamp, dpyinfo->server_time_offset, &t) + ? 0 : t); } +# ifndef CLOCK_MONOTONIC +# define CLOCK_MONOTONIC CLOCK_REALTIME +# endif + /* Return the current monotonic time in the same format as a - high-resolution server timestamp. */ + high-resolution server timestamp, or 0 if not available. */ -static uint64_t +static uint_fast64_t x_sync_current_monotonic_time (void) { struct timespec time; - - clock_gettime (CLOCK_MONOTONIC, &time); - return time.tv_sec * 1000000 + time.tv_nsec / 1000; + uint_fast64_t t; + return (((clock_gettime (CLOCK_MONOTONIC, &time) != 0 + && (CLOCK_MONOTONIC == CLOCK_REALTIME + || clock_gettime (CLOCK_REALTIME, &time) != 0)) + || INT_MULTIPLY_WRAPV (time.tv_sec, 1000000, &t) + || INT_ADD_WRAPV (t, time.tv_nsec / 1000, &t)) + ? 0 : t); } /* Decode a _NET_WM_FRAME_DRAWN message and calculate the time it took @@ -6747,7 +6757,7 @@ static void x_sync_note_frame_times (struct x_display_info *dpyinfo, struct frame *f, XEvent *event) { - uint64_t low, high, time; + uint_fast64_t low, high, time; struct x_output *output; low = event->xclient.data.l[2]; @@ -6756,12 +6766,16 @@ x_sync_note_frame_times (struct x_display_info *dpyinfo, time = x_sync_get_monotonic_time (dpyinfo, low | (high << 32)); - if (time) - output->last_frame_time = time - output->temp_frame_time; + if (!time || !output->temp_frame_time + || INT_SUBTRACT_WRAPV (time, output->temp_frame_time, + &output->last_frame_time)) + output->last_frame_time = 0; #ifdef FRAME_DEBUG - fprintf (stderr, "Drawing the last frame took: %lu ms (%lu)\n", - output->last_frame_time / 1000, time); + uint_fast64_t last_frame_ms = output->last_frame_time / 1000; + fprintf (stderr, + "Drawing the last frame took: %"PRIuFAST64" ms (%"PRIuFAST64")\n", + last_frame_ms, time); #endif } @@ -6891,7 +6905,7 @@ x_sync_update_begin (struct frame *f) static void x_sync_trigger_fence (struct frame *f, XSyncValue value) { - uint64_t n, low, high, idx; + uint_fast64_t n, low, high, idx; /* Sync fences aren't supported by the X server. */ if (FRAME_DISPLAY_INFO (f)->xsync_major < 3 @@ -7029,7 +7043,7 @@ x_sync_handle_frame_drawn (struct x_display_info *dpyinfo, static void x_update_begin (struct frame *f) { -#if defined HAVE_XSYNC && !defined USE_GTK +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME /* If F is double-buffered, we can make the entire frame center around XdbeSwapBuffers. */ #ifdef HAVE_XDBE @@ -7138,7 +7152,7 @@ show_back_buffer (struct frame *f) if (FRAME_X_DOUBLE_BUFFERED_P (f)) { -#if defined HAVE_XSYNC && !defined USE_GTK +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME /* Wait for drawing of the previous frame to complete before displaying this new frame. */ x_sync_wait_for_frame_drawn_event (f); @@ -7157,7 +7171,7 @@ show_back_buffer (struct frame *f) swap_info.swap_action = XdbeCopied; XdbeSwapBuffers (FRAME_X_DISPLAY (f), &swap_info, 1); -#if defined HAVE_XSYNC && !defined USE_GTK +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME /* Finish the frame here. */ x_sync_update_finish (f); #endif @@ -7211,7 +7225,7 @@ x_update_end (struct frame *f) /* If double buffering is disabled, finish the update here. Otherwise, finish the update when the back buffer is next displayed. */ -#if defined HAVE_XSYNC && !defined USE_GTK +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME #ifdef HAVE_XDBE if (!FRAME_X_DOUBLE_BUFFERED_P (f)) #endif @@ -7600,9 +7614,6 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time, #ifndef USE_GTK struct frame *focus_frame; Time old_time; -#if defined HAVE_XSYNC - uint64_t monotonic_time; -#endif focus_frame = dpyinfo->x_focus_frame; old_time = dpyinfo->last_user_time; @@ -7615,24 +7626,31 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time, if (!send_event || time > dpyinfo->last_user_time) dpyinfo->last_user_time = time; -#if defined HAVE_XSYNC && !defined USE_GTK +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME if (!send_event) { /* See if the current CLOCK_MONOTONIC time is reasonably close to the X server time. */ - monotonic_time = x_sync_current_monotonic_time (); + uint_fast64_t monotonic_time = x_sync_current_monotonic_time (); + uint_fast64_t monotonic_ms = monotonic_time / 1000; + int_fast64_t diff_ms; - if (time * 1000 > monotonic_time - 500 * 1000 - && time * 1000 < monotonic_time + 500 * 1000) - dpyinfo->server_time_monotonic_p = true; - else + dpyinfo->server_time_monotonic_p + = (monotonic_time != 0 + && !INT_SUBTRACT_WRAPV (time, monotonic_ms, &diff_ms) + && -500 < diff_ms && diff_ms < 500); + + if (!dpyinfo->server_time_monotonic_p) { /* Compute an offset that can be subtracted from the server time to estimate the monotonic time on the X server. */ - dpyinfo->server_time_monotonic_p = false; - dpyinfo->server_time_offset - = ((int64_t) time * 1000) - monotonic_time; + if (!monotonic_time + || INT_MULTIPLY_WRAPV (time, 1000, &dpyinfo->server_time_offset) + || INT_SUBTRACT_WRAPV (dpyinfo->server_time_offset, + monotonic_time, + &dpyinfo->server_time_offset)) + dpyinfo->server_time_offset = 0; } } #endif @@ -8298,6 +8316,8 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) ? CHAR_TABLE_REF (Vglyphless_char_display, glyph->u.glyphless.ch) : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (CONSP (acronym)) + acronym = XCAR (acronym); if (STRINGP (acronym)) str = SSDATA (acronym); } @@ -12186,6 +12206,11 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (device) x_dnd_keyboard_device = device->attachment; } + else + { + x_dnd_pointer_device = -1; + x_dnd_keyboard_device = -1; + } #endif @@ -12804,6 +12829,43 @@ xi_handle_interaction (struct x_display_info *dpyinfo, xi_handle_focus_change (dpyinfo); } +/* Return whether or not XEV actually represents a change in the + position of the pointer on DEVICE, with respect to the last event + received. This is necessary because the input extension reports + motion events in very high resolution, while Emacs is only fast + enough to process motion events aligned to the pixel grid. */ + +static bool +xi_position_changed (struct xi_device_t *device, XIDeviceEvent *xev) +{ + bool changed; + + changed = true; + + if (xev->event != device->last_motion_window) + goto out; + + if (lrint (xev->event_x) == device->last_motion_x + && lrint (xev->event_y) == device->last_motion_y) + { + changed = false; + goto out; + } + + out: + device->last_motion_x = lrint (xev->event_x); + device->last_motion_y = lrint (xev->event_y); + device->last_motion_window = xev->event; + + return changed; +} + +static void +xi_report_motion_window_clear (struct xi_device_t *device) +{ + device->last_motion_window = None; +} + #ifdef HAVE_XINPUT2_1 /* Look up a scroll valuator in DEVICE by NUMBER. */ @@ -13401,18 +13463,17 @@ get_keysym_name (int keysym) return value; } -/* Like XQueryPointer, but always use the right client pointer - device. */ - -Bool -x_query_pointer (Display *dpy, Window w, Window *root_return, - Window *child_return, int *root_x_return, - int *root_y_return, int *win_x_return, - int *win_y_return, unsigned int *mask_return) +static Bool +x_query_pointer_1 (struct x_display_info *dpyinfo, + int client_pointer_device, Window w, + Window *root_return, Window *child_return, + int *root_x_return, int *root_y_return, + int *win_x_return, int *win_y_return, + unsigned int *mask_return) { Bool rc; + Display *dpy; #ifdef HAVE_XINPUT2 - struct x_display_info *dpyinfo; bool had_errors; XIModifierState modifiers; XIButtonState buttons; @@ -13421,9 +13482,10 @@ x_query_pointer (Display *dpy, Window w, Window *root_return, unsigned int state; #endif + dpy = dpyinfo->display; + #ifdef HAVE_XINPUT2 - dpyinfo = x_display_info_for_display (dpy); - if (dpyinfo && dpyinfo->client_pointer_device != -1) + if (client_pointer_device != -1) { /* Catch errors caused by the device going away. This is not very expensive, since XIQueryPointer will sync anyway. */ @@ -13437,10 +13499,20 @@ x_query_pointer (Display *dpy, Window w, Window *root_return, x_uncatch_errors_after_check (); if (had_errors) - rc = XQueryPointer (dpyinfo->display, w, root_return, - child_return, root_x_return, - root_y_return, win_x_return, - win_y_return, mask_return); + { + /* If the specified client pointer is the display's client + pointer, clear it now. A new client pointer might not be + found before the next call to x_query_pointer_1 and + waiting for the error leads to excessive syncing. */ + + if (client_pointer_device == dpyinfo->client_pointer_device) + dpyinfo->client_pointer_device = -1; + + rc = XQueryPointer (dpyinfo->display, w, root_return, + child_return, root_x_return, + root_y_return, win_x_return, + win_y_return, mask_return); + } else { state = 0; @@ -13448,6 +13520,8 @@ x_query_pointer (Display *dpy, Window w, Window *root_return, xi_convert_button_state (&buttons, &state); *mask_return = state | modifiers.effective; + XFree (buttons.mask); + *root_x_return = lrint (root_x); *root_y_return = lrint (root_y); *win_x_return = lrint (win_x); @@ -13463,6 +13537,31 @@ x_query_pointer (Display *dpy, Window w, Window *root_return, return rc; } +Bool +x_query_pointer (Display *dpy, Window w, Window *root_return, + Window *child_return, int *root_x_return, + int *root_y_return, int *win_x_return, + int *win_y_return, unsigned int *mask_return) +{ + struct x_display_info *dpyinfo; + + dpyinfo = x_display_info_for_display (dpy); + + if (!dpyinfo) + emacs_abort (); + +#ifdef HAVE_XINPUT2 + return x_query_pointer_1 (dpyinfo, dpyinfo->client_pointer_device, + w, root_return, child_return, root_x_return, + root_y_return, win_x_return, win_y_return, + mask_return); +#else + return x_query_pointer_1 (dpyinfo, -1, w, root_return, child_return, + root_x_return, root_y_return, win_x_return, + win_y_return, mask_return); +#endif +} + /* Mouse clicks and mouse movement. Rah. Formerly, we used PointerMotionHintMask (in standard_event_mask) @@ -16902,11 +17001,19 @@ x_dnd_update_tooltip_now (void) dpyinfo = FRAME_DISPLAY_INFO (x_dnd_frame); +#ifndef HAVE_XINPUT2 rc = XQueryPointer (dpyinfo->display, dpyinfo->root_window, &root, &child, &root_x, &root_y, &win_x, &win_y, &mask); +#else + rc = x_query_pointer_1 (dpyinfo, x_dnd_pointer_device, + dpyinfo->root_window, + &root, &child, &root_x, + &root_y, &win_x, &win_y, + &mask); +#endif if (rc) x_dnd_update_tooltip_position (root_x, root_y); @@ -16926,12 +17033,17 @@ x_dnd_update_state (struct x_display_info *dpyinfo, Time timestamp) xm_drop_start_message dsmsg; bool was_frame; - if (XQueryPointer (dpyinfo->display, - dpyinfo->root_window, - &dummy, &dummy_child, - &root_x, &root_y, - &dummy_x, &dummy_y, - &dummy_mask)) + if (x_query_pointer_1 (dpyinfo, +#ifdef HAVE_XINPUT2 + x_dnd_pointer_device, +#else + -1, +#endif + dpyinfo->root_window, + &dummy, &dummy_child, + &root_x, &root_y, + &dummy_x, &dummy_y, + &dummy_mask)) { target = x_dnd_get_target_window (dpyinfo, root_x, root_y, &target_proto, @@ -17942,7 +18054,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto done; } -#if defined HAVE_XSYNC && !defined USE_GTK +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME /* These messages are sent by the compositing manager after a frame is drawn under extended synchronization. */ if (event->xclient.message_type @@ -19201,6 +19313,21 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case FocusIn: +#if defined HAVE_XINPUT2 \ + && (defined HAVE_GTK3 || (!defined USE_GTK && !defined USE_X_TOOLKIT)) + /* If a FocusIn event is received (because the window manager + sent us one), don't set the core focus if XInput 2 is + enabled, since that would mess up the device-specific focus + tracking. + + The long looking preprocessor conditional only enables this + code on GTK 3 and no toolkit builds, since those are the only + builds where focus is tracked specific to each master device. + Other builds use core events and the client pointer to handle + focus, much like on a build without XInput 2. */ + if (dpyinfo->supports_xi2) + goto OTHER; +#endif #ifdef USE_GTK /* Some WMs (e.g. Mutter in Gnome Shell), don't unmap minimized/iconified windows; thus, for those WMs we won't get @@ -19314,6 +19441,21 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case FocusOut: +#if defined HAVE_XINPUT2 \ + && (defined HAVE_GTK3 || (!defined USE_GTK && !defined USE_X_TOOLKIT)) + /* If a FocusIn event is received (because the window manager + sent us one), don't set the core focus if XInput 2 is + enabled, since that would mess up the device-specific focus + tracking. + + The long looking preprocessor conditional only enables this + code on GTK 3 and no toolkit builds, since those are the only + builds where focus is tracked specific to each master device. + Other builds use core events and the client pointer to handle + focus, much like on a build without XInput 2. */ + if (dpyinfo->supports_xi2) + goto OTHER; +#endif x_detect_focus_change (dpyinfo, any, event, &inev.ie); goto OTHER; @@ -19977,6 +20119,28 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif +#ifdef HAVE_XINPUT2 + if (f && dpyinfo->supports_xi2) + { + Mouse_HLInfo *hlinfo; + + /* The input extension doesn't report motion events when + the part of the window below the pointer changes. To + avoid outdated information from keeping + i.e. mouse-highlight at the wrong position after the + frame is moved or resized, reset the mouse highlight + and last_mouse_motion_frame. */ + + if (dpyinfo->last_mouse_motion_frame == f) + dpyinfo->last_mouse_motion_frame = NULL; + + hlinfo = MOUSE_HL_INFO (f); + + if (hlinfo->mouse_face_mouse_frame == f) + reset_mouse_highlight (hlinfo); + } +#endif + } if (x_dnd_in_progress @@ -20217,7 +20381,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, { block_input (); XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - RevertToParent, CurrentTime); + RevertToParent, event->xbutton.time); if (FRAME_PARENT_FRAME (f)) XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); unblock_input (); @@ -20466,11 +20630,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, bool must_free_data = false; XIEvent *xi_event = (XIEvent *) event->xcookie.data; + /* Sometimes the event is already claimed by GTK, which will free its data in due course. */ - if (!xi_event && XGetEventData (dpyinfo->display, &event->xcookie)) + if (!xi_event) { - must_free_data = true; + if (XGetEventData (dpyinfo->display, &event->xcookie)) + must_free_data = true; + xi_event = (XIEvent *) event->xcookie.data; } @@ -20478,7 +20645,25 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!xi_event) { - eassert (!must_free_data); + /* It may turn out that the event data has already been + implicitly freed for various reasons up to and + including XMenuActivate pushing some other event onto + the foreign-event queue, or x_menu_wait_for_events + calling XNextEvent through a timer that tries to wait + for input. + + In that case, XGetEventData will return True, but + cookie->data will be NULL. Since handling such input + events is not really important, we can afford to + discard them. + + The way Xlib is currently implemented makes calling + XFreeEventData unnecessary in this case, but call it + anyway, since not doing so may lead to a memory leak in + the future. */ + + if (must_free_data) + XFreeEventData (dpyinfo->display, &event->xcookie); goto OTHER; } @@ -20630,7 +20815,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_Leave: { - XILeaveEvent *leave = (XILeaveEvent *) xi_event; + XILeaveEvent *leave; + struct xi_device_t *device; + + leave = (XILeaveEvent *) xi_event; #ifdef USE_GTK struct xi_device_t *source; XMotionEvent ev; @@ -20647,6 +20835,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef USE_GTK source = xi_device_from_id (dpyinfo, leave->sourceid); #endif + device = xi_device_from_id (dpyinfo, leave->deviceid); + + if (device) + xi_report_motion_window_clear (device); /* This allows us to catch LeaveNotify events generated by popup menu grabs. FIXME: this is right when there is a @@ -21066,6 +21258,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif #endif /* HAVE_XINPUT2_1 */ + if (!xi_position_changed (device, xev)) + goto XI_OTHER; + ev.x = lrint (xev->event_x); ev.y = lrint (xev->event_y); ev.window = xev->event; @@ -21481,7 +21676,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, else { dpyinfo->grabbed &= ~(1 << xev->detail); - device->grab &= ~(1 << xev->detail); + if (device) + device->grab &= ~(1 << xev->detail); } #ifdef XIPointerEmulated } @@ -21798,8 +21994,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf))) { block_input (); +#if defined HAVE_GTK3 || (!defined USE_GTK && !defined USE_X_TOOLKIT) + if (device) + { + /* This can generate XI_BadDevice if the + device's attachment was destroyed + server-side. */ + x_ignore_errors_for_next_request (dpyinfo); + XISetFocus (dpyinfo->display, device->attachment, + /* Note that the input extension + only supports RevertToParent-type + behavior. */ + FRAME_OUTER_WINDOW (f), xev->time); + x_stop_ignoring_errors (dpyinfo); + } +#else + /* Non-no toolkit builds without GTK 3 use core + events to handle focus. */ XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - RevertToParent, CurrentTime); + RevertToParent, xev->time); +#endif if (FRAME_PARENT_FRAME (f)) XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); unblock_input (); @@ -22653,13 +22867,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (info) { - if (device && info->enabled) + if (device) { device->use = info->use; device->attachment = info->attachment; } - else if (device) - disabled[n_disabled++] = hev->info[i].deviceid; + + /* device could have been disabled by now. + But instead of removing it immediately, + wait for XIDeviceDisabled, or internal + state could be left inconsistent. */ XIFreeDeviceInfo (info); } @@ -22981,6 +23198,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (xkbevent->any.xkb_type == XkbNewKeyboardNotify || xkbevent->any.xkb_type == XkbMapNotify) { + XkbRefreshKeyboardMapping (&xkbevent->map); + if (dpyinfo->xkb_desc) { if (XkbGetUpdatedMap (dpyinfo->display, @@ -22989,11 +23208,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, | XkbModifierMapMask | XkbVirtualModsMask), dpyinfo->xkb_desc) == Success) - { - XkbGetNames (dpyinfo->display, - XkbGroupNamesMask | XkbVirtualModNamesMask, - dpyinfo->xkb_desc); - } + XkbGetNames (dpyinfo->display, + XkbGroupNamesMask | XkbVirtualModNamesMask, + dpyinfo->xkb_desc); else { XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True); @@ -23015,7 +23232,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, dpyinfo->xkb_desc); } - XkbRefreshKeyboardMapping (&xkbevent->map); x_find_modifier_meanings (dpyinfo); } else if (x_dnd_in_progress @@ -26950,7 +27166,7 @@ x_free_frame_resources (struct frame *f) XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_left_corner_cursor); /* Free sync fences. */ -#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK +#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK && defined HAVE_CLOCK_GETTIME x_sync_free_fences (f); #endif } @@ -27651,6 +27867,8 @@ xi_select_hierarchy_events (struct x_display_info *dpyinfo) memset (m, 0, l); mask.mask_len = l; + mask.deviceid = XIAllDevices; + XISetMask (m, XI_PropertyEvent); XISetMask (m, XI_HierarchyChanged); XISetMask (m, XI_DeviceChanged); @@ -27661,6 +27879,42 @@ xi_select_hierarchy_events (struct x_display_info *dpyinfo) #endif +#if defined HAVE_XINPUT2 && defined HAVE_GTK3 + +/* Look up whether or not GTK already initialized the X input + extension. + + Value is 0 if GTK was not built with the input extension, or if it + was explictly disabled, 1 if GTK enabled the input extension and + the version was successfully determined, and 2 if that information + could not be determined. */ + +static int +xi_check_toolkit (Display *display) +{ + GdkDisplay *gdpy; + GdkDeviceManager *manager; + + gdpy = gdk_x11_lookup_xdisplay (display); + eassume (gdpy); + manager = gdk_display_get_device_manager (gdpy); + + if (!strcmp (G_OBJECT_TYPE_NAME (manager), + "GdkX11DeviceManagerXI2")) + return 1; + + if (!strcmp (G_OBJECT_TYPE_NAME (manager), + "GdkX11DeviceManagerCore")) + return 0; + + /* Something changed in GDK so this information is no longer + available. */ + + return 2; +} + +#endif + /* Open a connection to X display DISPLAY_NAME, and return the structure that describes the open display. If we cannot contact the display, return null. */ @@ -28205,6 +28459,17 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->client_pointer_device = -1; +#ifdef HAVE_GTK3 + /* GTK gets a chance to request use of the input extension first. + If we later try to enable it if GDK did not, then GTK will not + get the resulting extension events. */ + + rc = xi_check_toolkit (dpyinfo->display); + + if (!rc) + goto skip_xi_setup; +#endif + if (XQueryExtension (dpyinfo->display, "XInputExtension", &dpyinfo->xi2_opcode, &xi_first_event, &xi_first_error)) @@ -28301,9 +28566,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) } dpyinfo->xi2_version = minor; -#ifndef HAVE_GTK3 skip_xi_setup: -#endif ; #endif diff --git a/src/xterm.h b/src/xterm.h index e97f3d4c831..a0ae3a330a9 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -286,6 +286,12 @@ struct xi_device_t /* The frame that is currently this device's implicit keyboard focus, or NULL. */ struct frame *focus_implicit_frame; + + /* The window on which the last motion event happened. */ + Window last_motion_window; + + /* The rounded integer coordinates of the last motion event. */ + int last_motion_x, last_motion_y; }; #endif @@ -822,14 +828,15 @@ struct x_display_info drag-and-drop emulation. */ Time pending_dnd_time; -#if defined HAVE_XSYNC && !defined USE_GTK +#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME /* Whether or not the server time is probably the same as "clock_gettime (CLOCK_MONOTONIC, ...)". */ bool server_time_monotonic_p; /* The time difference between the X server clock and the monotonic - clock. */ - int64_t server_time_offset; + clock, or 0 if unknown (if the difference is legitimately 0, + server_time_monotonic_p will be true). */ + int_fast64_t server_time_offset; #endif }; @@ -1119,16 +1126,16 @@ struct x_output frame. */ bool_bf waiting_for_frame_p : 1; -#ifndef USE_GTK +#if !defined USE_GTK && defined HAVE_CLOCK_GETTIME /* Whether or not Emacs should wait for the compositing manager to draw frames before starting a new frame. */ bool_bf use_vsync_p : 1; /* The time (in microseconds) it took to draw the last frame. */ - uint64_t last_frame_time; + uint_fast64_t last_frame_time; /* A temporary time used to calculate that value. */ - uint64_t temp_frame_time; + uint_fast64_t temp_frame_time; #ifdef HAVE_XSYNCTRIGGERFENCE /* An array of two sync fences that are triggered in order after a @@ -1577,7 +1584,8 @@ extern void x_make_frame_invisible (struct frame *); extern void x_iconify_frame (struct frame *); extern void x_free_frame_resources (struct frame *); extern void x_wm_set_size_hint (struct frame *, long, bool); -#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK +#if defined HAVE_XSYNCTRIGGERFENCE && !defined USE_GTK \ + && defined HAVE_CLOCK_GETTIME extern void x_sync_init_fences (struct frame *); #endif diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 54b1a16b5db..4bbff6d0578 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -105,7 +105,7 @@ This expects `auto-revert--messages' to be bound by (auto-revert--timeout)) (null (string-match (format-message - "Reverting buffer `%s'\\." (buffer-name buffer)) + "Reverting buffer `%s'" (buffer-name buffer)) (or auto-revert--messages "")))) (if (and (or file-notify--library (file-remote-p temporary-file-directory)) diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 0102b62c10f..95855d1e639 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -459,7 +459,7 @@ the top done item should be the first done item." todo-date-pattern "\\( " diary-time-regexp "\\)?" (regexp-quote todo-nondiary-end) "?") - (line-end-position) t) + (pos-eol) t) (forward-char) (point))) (start1 (save-excursion (funcall find-start))) @@ -854,7 +854,7 @@ item's date should be adjusted accordingly." (let ((current-prefix-arg t) ; For todo-edit-item--header. (get-date (lambda () (save-excursion - (todo-date-string-matcher (line-end-position)) + (todo-date-string-matcher (pos-eol)) (buffer-substring-no-properties (match-beginning 1) (match-end 0)))))) (should (equal (funcall get-date) "Jan 1, 2020")) @@ -903,7 +903,7 @@ tab character." (todo-test--insert-item item 1) (re-search-forward (concat todo-date-string-start todo-date-pattern (regexp-quote todo-nondiary-end) " ") - (line-end-position) t) + (pos-eol) t) (should (looking-at (regexp-quote (concat item0 "\n\t" item1))))))) (ert-deftest todo-test-multiline-item-indentation-2 () ; bug#43068 @@ -917,7 +917,7 @@ begin with a tab character." (todo-edit-item--text 'multiline) (insert (concat "\n" item1)) (todo-edit-quit) - (goto-char (line-beginning-position)) + (goto-char (pos-bol)) (should (looking-at (regexp-quote (concat item0 "\n\t" item1))))))) (ert-deftest todo-test-multiline-item-indentation-3 () @@ -930,7 +930,7 @@ since all non-initial item lines must begin with whitespace." (item1 "Second line.")) (todo-edit-file) (should (looking-at (regexp-quote item0))) - (goto-char (line-end-position)) + (goto-char (pos-eol)) (insert (concat "\n" item1)) (should-error (todo-edit-quit) :type 'user-error)))) diff --git a/test/lisp/cedet/semantic-utest-ia.el b/test/lisp/cedet/semantic-utest-ia.el index caf20fa8e07..fa3b3185ed5 100644 --- a/test/lisp/cedet/semantic-utest-ia.el +++ b/test/lisp/cedet/semantic-utest-ia.el @@ -194,7 +194,7 @@ (goto-char a) - (let ((bss (buffer-substring-no-properties (point) (point-at-eol)))) + (let ((bss (buffer-substring-no-properties (point) (pos-eol)))) (condition-case nil (setq desired (read bss)) (error (setq desired (format " FAILED TO PARSE: %S" @@ -215,8 +215,8 @@ ) fail))) - (setq p nil a nil) - (setq idx (1+ idx))) + (setq p nil a nil) + (setq idx (1+ idx))) ) (when fail @@ -353,7 +353,7 @@ (when (re-search-forward regex-p nil t) (setq tag (semantic-current-tag)) (goto-char (match-end 0)) - (setq desired (read (buffer-substring (point) (point-at-eol)))) + (setq desired (read (buffer-substring (point) (pos-eol)))) )) tag) @@ -451,7 +451,7 @@ tag that contains point, and return that." (when (re-search-forward regex-p nil t) (goto-char (match-end 0)) (skip-syntax-backward "w") - (setq desired (read (buffer-substring (point) (point-at-eol)))) + (setq desired (read (buffer-substring (point) (pos-eol)))) (setq start (match-beginning 0)) (goto-char start) (setq actual (semantic-symref-test-count-hits-in-tag)) @@ -463,7 +463,7 @@ tag that contains point, and return that." (list (format "Symref id %d: No results." idx)) - fail)) + fail)) ) diff --git a/test/lisp/cedet/semantic-utest.el b/test/lisp/cedet/semantic-utest.el index 78bbbbf4592..24a467474b9 100644 --- a/test/lisp/cedet/semantic-utest.el +++ b/test/lisp/cedet/semantic-utest.el @@ -736,8 +736,8 @@ JAVE this thing would need to be recursive to handle java and csharp" (beginning-of-line) (setq semantic-utest-last-kill-pos (point)) (setq semantic-utest-last-kill-text - (buffer-substring (point) (point-at-eol))) - (delete-region (point) (point-at-eol)) + (buffer-substring (point) (pos-eol))) + (delete-region (point) (pos-eol)) (insert insertme) (sit-for 0) ) @@ -745,7 +745,7 @@ JAVE this thing would need to be recursive to handle java and csharp" (defun semantic-utest-unkill-indicator () "Unkill the last indicator." (goto-char semantic-utest-last-kill-pos) - (delete-region (point) (point-at-eol)) + (delete-region (point) (pos-eol)) (insert semantic-utest-last-kill-text) (sit-for 0) ) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 694deaae4c2..e70898ab74e 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -154,5 +154,18 @@ (should (string-match (regexp-quote command) (nth 0 lines))) (dired-test--check-highlighting (nth 0 lines) '(8)))) +(ert-deftest dired-guess-default () + (let ((dired-guess-shell-alist-user nil) + (dired-guess-shell-alist-default + '(("\\.png\\'" "display") + ("\\.gif\\'" "display" "xloadimage") + ("\\.gif\\'" "feh") + ("\\.jpe?g\\'" "xloadimage")))) + (should (equal (dired-guess-default '("/tmp/foo.png")) "display")) + (should (equal (dired-guess-default '("/tmp/foo.gif")) + '("display" "xloadimage" "feh"))) + (should (equal (dired-guess-default '("/tmp/foo.png" "/tmp/foo.txt")) + nil)))) + (provide 'dired-aux-tests) ;;; dired-aux-tests.el ends here diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 0e893259077..9cf01519052 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -313,7 +313,7 @@ (save-excursion (goto-char 1) (forward-line 1) - (- (point-at-eol) (point))))) + (- (pos-eol) (point))))) orig-len len diff pos line-nb) (make-directory subdir 'parents) (with-current-buffer (dired-noselect subdir) @@ -331,7 +331,7 @@ (forward-line 1) (let ((inhibit-read-only t) (new-header " test-bug27968")) - (delete-region (point) (point-at-eol)) + (delete-region (point) (pos-eol)) (when (= orig-len (length new-header)) ;; Wow lucky guy! I must buy lottery today. (setq new-header (concat new-header " :-)"))) diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el index cec266b0ef9..7acaa3c1319 100644 --- a/test/lisp/dired-x-tests.el +++ b/test/lisp/dired-x-tests.el @@ -47,19 +47,6 @@ (should (equal all-but-c (sort (dired-get-marked-files 'local) #'string<)))))) -(ert-deftest dired-guess-default () - (let ((dired-guess-shell-alist-user nil) - (dired-guess-shell-alist-default - '(("\\.png\\'" "display") - ("\\.gif\\'" "display" "xloadimage") - ("\\.gif\\'" "feh") - ("\\.jpe?g\\'" "xloadimage")))) - (should (equal (dired-guess-default '("/tmp/foo.png")) "display")) - (should (equal (dired-guess-default '("/tmp/foo.gif")) - '("display" "xloadimage" "feh"))) - (should (equal (dired-guess-default '("/tmp/foo.png" "/tmp/foo.txt")) - nil)))) - (ert-deftest dired-x--string-to-number () (should (= (dired-x--string-to-number "2.4K") 2457.6)) (should (= (dired-x--string-to-number "2400") 2400)) diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el index b08695a22bb..b42de06776b 100644 --- a/test/lisp/emacs-lisp/backtrace-tests.el +++ b/test/lisp/emacs-lisp/backtrace-tests.el @@ -274,16 +274,16 @@ line contains the strings \"lambda\" and \"number\"." ;; Verify the form now spans multiple lines. (let ((pos (point))) (search-forward "number") - (should-not (= pos (point-at-bol)))) + (should-not (= pos (pos-bol)))) ;; Collapse the form. (backtrace-single-line) ;; Verify that the form is now back on one line, ;; and that point is at the same place. (should (string= (backtrace-tests--get-substring (- (point) 6) (point)) "number")) - (should-not (= (point) (point-at-bol))) + (should-not (= (point) (pos-bol))) (should (string= (backtrace-tests--get-substring - (point-at-bol) (1+ (point-at-eol))) + (pos-bol) (1+ (pos-eol))) line))) (ert-deftest backtrace-tests--print-circle () diff --git a/test/lisp/emacs-lisp/find-func-tests.el b/test/lisp/emacs-lisp/find-func-tests.el index 420c61acb55..d18a9dc1a94 100644 --- a/test/lisp/emacs-lisp/find-func-tests.el +++ b/test/lisp/emacs-lisp/find-func-tests.el @@ -109,9 +109,7 @@ expected function symbol and function library, respectively." (skip-chars-backward "\n") (should (string-match-p ".join-line. is an alias for .delete-indentation." - (buffer-substring - (line-beginning-position) - (point))))))) + (buffer-substring (pos-bol) (point))))))) ;; Avoid a byte-compilation warning that may confuse people reading ;; the result of the following test. diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index d3e78aa1d7e..996ea201fb0 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -342,16 +342,18 @@ Expected initialization file: `%s'\" (insert "(define-flabbergast-test zot ()\n'bar)\n") (goto-char 5) (should (equal (lisp-current-defun-name) "zot"))) - (with-temp-buffer - (emacs-lisp-mode) - (insert "(progn\n ;; comment\n ;; about that\n (define-key ...)\n )") - (goto-char 5) - (should (equal (lisp-current-defun-name) "progn"))) - (with-temp-buffer - (emacs-lisp-mode) - (insert "(defblarg \"a\" 'b)") - (goto-char 5) - (should (equal (lisp-current-defun-name) "defblarg")))) + ;; These tests should probably work after bug#49592 has been fixed. + ;; (with-temp-buffer + ;; (emacs-lisp-mode) + ;; (insert "(progn\n ;; comment\n ;; about that\n (define-key ...)\n )") + ;; (goto-char 5) + ;; (should (equal (lisp-current-defun-name) "progn"))) + ;; (with-temp-buffer + ;; (emacs-lisp-mode) + ;; (insert "(defblarg \"a\" 'b)") + ;; (goto-char 5) + ;; (should (equal (lisp-current-defun-name) "defblarg"))) + ) (provide 'lisp-mode-tests) ;;; lisp-mode-tests.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 0f222edacfa..55efe2fd2d9 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -522,7 +522,7 @@ (erc-send-current-line) (should (ring-p erc-input-ring)) (should (zerop (ring-member erc-input-ring "/one"))) ; equal - (should (save-excursion (forward-line -1) (goto-char (point-at-bol)) + (should (save-excursion (forward-line -1) (goto-char (pos-bol)) (looking-at-p "[*]+ echo: one"))) (should-not erc-input-ring-index) (erc-bol) @@ -575,15 +575,15 @@ (goto-char (point-min)) (search-forward "Version") (search-forward "\r\n\r\n") - (search-forward "myproxy.localhost:6667 >> PASS" (line-end-position)) + (search-forward "myproxy.localhost:6667 >> PASS" (pos-eol)) (forward-line) - (search-forward "irc.gnu.org << :irc.gnu.org 001" (line-end-position)) + (search-forward "irc.gnu.org << :irc.gnu.org 001" (pos-eol)) (forward-line) - (search-forward "irc.gnu.org << :irc.gnu.org 002" (line-end-position)) + (search-forward "irc.gnu.org << :irc.gnu.org 002" (pos-eol)) (forward-line) - (search-forward "FooNet << :irc.gnu.org 422" (line-end-position)) + (search-forward "FooNet << :irc.gnu.org 422" (pos-eol)) (forward-line) - (search-forward "BarNet << :irc.gnu.org 221" (line-end-position))) + (search-forward "BarNet << :irc.gnu.org 221" (pos-eol))) (when noninteractive (kill-buffer "*erc-protocol*") (should-not erc-debug-irc-protocol))) diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index 2369bb5cc00..62e784e8f62 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -74,6 +74,8 @@ (ert-deftest esh-proc-test/pipeline-connection-type/middle () "Test that all streams are pipes when a command is in the middle of a pipeline." + ;; Repeated unreproducible errors. + :tags '(:unstable) (skip-unless (and (executable-find "sh") (executable-find "cat"))) (eshell-command-result-equal @@ -82,6 +84,8 @@ pipeline." (ert-deftest esh-proc-test/pipeline-connection-type/last () "Test that only output streams are PTYs when a command ends a pipeline." + ;; Repeated unreproducible errors. + :tags '(:unstable) (skip-unless (executable-find "sh")) (eshell-command-result-equal (concat "echo | " esh-proc-test--detect-pty-cmd) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 54ada088003..682b5cdb449 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -221,22 +221,41 @@ form.") ("x:/foo//bar/" "y:/bar/qux/" "z:/qux/foo/")) ("x:/foo/bar" "$FOO/baz/;z:/qux/foo/" ("x:/foo/bar/baz/" "z:/qux/foo/")) - ("//foo/bar/" "$FOO/baz/;/qux/foo/" - ("/foo/bar//baz/" "/qux/foo/"))) - '(("/foo/bar//baz/:/bar/foo/baz//" nil - ("/foo/bar//baz/" "/bar/foo/baz//")) - ("/foo/bar/:/bar/qux/:/qux/foo" nil - ("/foo/bar/" "/bar/qux/" "/qux/foo/")) - ("//foo/bar/:/bar/qux/:/qux/foo/" nil - ("/foo/bar/" "/bar/qux/" "/qux/foo/")) - ("/foo/bar/:/bar/qux/:/qux/foo/" nil - ("/foo/bar/" "/bar/qux/" "/qux/foo/")) - ("/foo//bar/:/bar/qux/:/qux/foo/" nil - ("/foo//bar/" "/bar/qux/" "/qux/foo/")) - ("/foo//bar/:/bar/qux/:/qux/foo" nil - ("/foo//bar/" "/bar/qux/" "/qux/foo/")) - ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/")) - ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar//baz/" "/qux/foo/"))))) + ("///foo/bar/" "$FOO/baz/;/qux/foo/" + ("//foo/bar//baz/" "/qux/foo/"))) + (if (eq system-type 'cygwin) + '(("/foo/bar//baz/:/bar/foo/baz//" nil + ("/foo/bar//baz/" "/bar/foo/baz//")) + ("/foo/bar/:/bar/qux/:/qux/foo" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("//foo/bar/:/bar/qux/:/qux/foo/" nil + ("//foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo/bar/:/bar/qux/:/qux/foo/" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo//bar/:/bar/qux/:/qux/foo/" nil + ("/foo//bar/" "/bar/qux/" "/qux/foo/")) + ("/foo//bar/:/bar/qux/:/qux/foo" nil + ("/foo//bar/" "/bar/qux/" "/qux/foo/")) + ("/foo/bar" "$FOO/baz/:/qux/foo/" + ("/foo/bar/baz/" "/qux/foo/")) + ("///foo/bar/" "$FOO/baz/:/qux/foo/" + ("//foo/bar//baz/" "/qux/foo/"))) + '(("/foo/bar//baz/:/bar/foo/baz//" nil + ("/foo/bar//baz/" "/bar/foo/baz//")) + ("/foo/bar/:/bar/qux/:/qux/foo" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("//foo/bar/:/bar/qux/:/qux/foo/" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo/bar/:/bar/qux/:/qux/foo/" nil + ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo//bar/:/bar/qux/:/qux/foo/" nil + ("/foo//bar/" "/bar/qux/" "/qux/foo/")) + ("/foo//bar/:/bar/qux/:/qux/foo" nil + ("/foo//bar/" "/bar/qux/" "/qux/foo/")) + ("/foo/bar" "$FOO/baz/:/qux/foo/" + ("/foo/bar/baz/" "/qux/foo/")) + ("//foo/bar/" "$FOO/baz/:/qux/foo/" + ("/foo/bar//baz/" "/qux/foo/")))))) (foo-env (getenv "FOO")) (bar-env (getenv "BAR"))) (unwind-protect @@ -1504,7 +1523,11 @@ See <https://debbugs.gnu.org/36401>." (should (equal (parse-colon-path "/foo//bar/baz") '("/foo//bar/baz/")))) (should (equal (parse-colon-path (concat "." path-separator "/tmp")) - '("./" "/tmp/")))) + '("./" "/tmp/"))) + (should (equal (parse-colon-path (concat "/foo" path-separator "///bar")) + (if (memq system-type '(windows-nt cygwin ms-dos)) + '("/foo/" "//bar/") + '("/foo/" "/bar/"))))) (ert-deftest files-test-magic-mode-alist-doctype () "Test that DOCTYPE and variants put files in mhtml-mode." diff --git a/test/lisp/gnus/message-tests.el b/test/lisp/gnus/message-tests.el index 8f3c1250a9e..a724428ecb4 100644 --- a/test/lisp/gnus/message-tests.el +++ b/test/lisp/gnus/message-tests.el @@ -47,14 +47,10 @@ (setq-local parse-sexp-lookup-properties t) (backward-sexp) (should (string= "here's an opener " - (buffer-substring-no-properties - (line-beginning-position) - (point)))) + (buffer-substring-no-properties (pos-bol) (point)))) (forward-sexp) (should (string= "and here's a closer )" - (buffer-substring-no-properties - (line-beginning-position) - (point))))) + (buffer-substring-no-properties (pos-bol) (point))))) (set-buffer-modified-p nil)))) diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 7f30b27b00d..833c32ffb27 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -55,18 +55,24 @@ (should (equal (help-split-fundoc nil t 'usage) nil)) (should (equal (help-split-fundoc nil t 'doc) nil)))) +(ert-deftest help--key-description-fontified () + (should (equal (help--key-description-fontified + (where-is-internal #'next-line nil t)) + "C-n")) + (should-not (help--key-description-fontified nil))) + ;;; substitute-command-keys (defmacro with-substitute-command-keys-test (&rest body) `(cl-flet* ((test - (lambda (orig result) - (should (equal (substitute-command-keys orig) - result)))) + (lambda (orig result) + (should (equal (substitute-command-keys orig) + result)))) (test-re - (lambda (orig regexp) - (should (string-match (concat "\\`" regexp "\\'") - (substitute-command-keys orig)))))) + (lambda (orig regexp) + (should (string-match (concat "\\`" regexp "\\'") + (substitute-command-keys orig)))))) ,@body)) (ert-deftest help-tests-substitute-command-keys/no-change () diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el index acfd6e82f16..117170ba338 100644 --- a/test/lisp/info-xref-tests.el +++ b/test/lisp/info-xref-tests.el @@ -161,8 +161,7 @@ text. (should (search-backward "done" nil t)) (should (string-match-p " [0-9]\\{3,\\} good, 0 bad" - (buffer-substring-no-properties (line-beginning-position) - (line-end-position))))))) + (buffer-substring-no-properties (pos-bol) (pos-eol))))))) ;;; info-xref-tests.el ends here diff --git a/test/lisp/mail/footnote-tests.el b/test/lisp/mail/footnote-tests.el index e33b59bc416..f3a35e3dfc6 100644 --- a/test/lisp/mail/footnote-tests.el +++ b/test/lisp/mail/footnote-tests.el @@ -40,7 +40,7 @@ (footnote-back-to-message) (should (equal (buffer-substring (point-min) (point)) "hello[1]")) - (should (equal (buffer-substring (point-min) (line-end-position)) + (should (equal (buffer-substring (point-min) (pos-eol)) "hello[1][2] world")))) (provide 'footnote-tests) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index f51037aabb4..964404b4bf7 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -40,7 +40,8 @@ "Format for `ert-resource-directory'.") (defvar ert-resource-directory-trim-left-regexp "" "Regexp for `string-trim' (left) used by `ert-resource-directory'.") - (defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el" + (defvar ert-resource-directory-trim-right-regexp + (rx (? "-test" (? "s")) ".el") "Regexp for `string-trim' (right) used by `ert-resource-directory'.") (defmacro ert-resource-directory () @@ -615,13 +616,13 @@ This checks also `file-name-as-directory', `file-name-directory', (insert-directory tramp-archive-test-archive nil) (goto-char (point-min)) (should - (looking-at-p (regexp-quote tramp-archive-test-archive)))) + (looking-at-p (rx (literal tramp-archive-test-archive))))) (with-temp-buffer (insert-directory tramp-archive-test-archive "-al") (goto-char (point-min)) (should (looking-at-p - (format "^.+ %s$" (regexp-quote tramp-archive-test-archive))))) + (rx bol (+ nonl) " " (literal tramp-archive-test-archive) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tramp-archive-test-archive) @@ -629,15 +630,17 @@ This checks also `file-name-as-directory', `file-name-directory', (goto-char (point-min)) (should (looking-at-p - (concat - ;; There might be a summary line. - "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?" - ;; We don't know in which order the files appear. - (format - "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}" - (regexp-opt (directory-files tramp-archive-test-archive)) - (length (directory-files tramp-archive-test-archive))))))) - + (rx-to-string + `(: + ;; There might be a summary line. + (? "total" (+ nonl) (+ digit) (? " ") + (? (any "EGKMPTYZk")) (? "i") (? "B") "\n") + ;; We don't know in which order the files appear. + (= ,(length (directory-files tramp-archive-test-archive)) + (+ nonl) " " + (regexp + ,(regexp-opt (directory-files tramp-archive-test-archive))) + (? " ->" (one-or-more nonl)) "\n")))))) ;; Check error case. (with-temp-buffer (should-error @@ -727,7 +730,7 @@ This tests also `access-file', `file-readable-p' and `file-regular-p'." (setq attr (directory-files-and-attributes tmp-name 'full)) (dolist (elt attr) (should (equal (file-attributes (car elt)) (cdr elt)))) - (setq attr (directory-files-and-attributes tmp-name nil "\\`b")) + (setq attr (directory-files-and-attributes tmp-name nil (rx bos "b"))) (should (equal (mapcar #'car attr) '("bar")))) ;; Cleanup. @@ -914,11 +917,14 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) (should (string-match - (format - "tramp-archive loaded: %s[[:ascii:]]+tramp-archive loaded: %s" - (tramp-archive-file-name-p default-directory) - (or (tramp-archive-file-name-p default-directory) - (and enabled (tramp-archive-file-name-p file)))) + (rx "tramp-archive loaded: " + (literal (symbol-name + (tramp-archive-file-name-p default-directory))) + (+ ascii) + "tramp-archive loaded: " + (literal (symbol-name + (or (tramp-archive-file-name-p default-directory) + (and enabled (tramp-archive-file-name-p file)))))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s --eval %s" @@ -955,9 +961,9 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (dolist (tae '(t nil)) (should (string-match - (format - "tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: %s" - tae) + (rx "tramp-archive loaded: nil" (+ ascii) + "tramp-archive loaded: nil" (+ ascii) + "tramp-archive loaded: " (literal (symbol-name tae))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -1005,7 +1011,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (apply 'append (mapcar - (lambda (x) (directory-files (concat dir x) 'full "uu\\'" 'sort)) + (lambda (x) + (directory-files (concat dir x) 'full (rx "uu" eos) 'sort)) '("~/src/libarchive-3.2.2/libarchive/test" "~/src/libarchive-3.2.2/cpio/test" "~/src/libarchive-3.2.2/tar/test")))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4dcf671f51f..bc67ff2ace7 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -91,7 +91,8 @@ "Format for `ert-resource-directory'.") (defvar ert-resource-directory-trim-left-regexp "" "Regexp for `string-trim' (left) used by `ert-resource-directory'.") - (defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el" + (defvar ert-resource-directory-trim-right-regexp + (rx (? "-test" (? "s")) ".el") "Regexp for `string-trim' (right) used by `ert-resource-directory'.") (defmacro ert-resource-directory () @@ -204,7 +205,7 @@ being the result.") ;; Remove old test files. (dolist (dir `(,temporary-file-directory ,ert-remote-temporary-file-directory)) - (dolist (file (directory-files dir 'full "\\`\\(\\.#\\)?tramp-test")) + (dolist (file (directory-files dir 'full (rx bos (? ".#") "tramp-test"))) (ignore-errors (if (file-directory-p file) (delete-directory file 'recursive) @@ -387,15 +388,17 @@ Also see `ignore'." ;; `tramp-ignored-file-name-regexp' suppresses Tramp. (let ((tramp-ignored-file-name-regexp "^/method:user@host:")) (should-not (tramp-tramp-file-p "/method:user@host:"))) - ;; Methods shall be at least two characters on MS Windows, - ;; except the default method. + ;; Methods shall be at least two characters, except the + ;; default method. (let ((system-type 'windows-nt)) (should-not (tramp-tramp-file-p "/c:/path/to/file")) (should-not (tramp-tramp-file-p "/c::/path/to/file")) - (should (tramp-tramp-file-p "/-::/path/to/file"))) + (should (tramp-tramp-file-p "/-::/path/to/file")) + (should (tramp-tramp-file-p "/mm::/path/to/file"))) (let ((system-type 'gnu/linux)) + (should-not (tramp-tramp-file-p "/m::/path/to/file")) (should (tramp-tramp-file-p "/-:h:/path/to/file")) - (should (tramp-tramp-file-p "/m::/path/to/file")))) + (should (tramp-tramp-file-p "/mm::/path/to/file")))) ;; Exit. (tramp-change-syntax syntax)))) @@ -1064,8 +1067,7 @@ Also see `ignore'." (file-remote-p "/user@email@host:") (format "/%s@%s:" "user@email" "host"))) (should (string-equal - (file-remote-p - "/user@email@host:" 'method) "default-method")) + (file-remote-p "/user@email@host:" 'method) "default-method")) (should (string-equal (file-remote-p "/user@email@host:" 'user) "user@email")) (should (string-equal @@ -1474,11 +1476,10 @@ Also see `ignore'." (file-remote-p "/[method/user@email@host]") (format "/[%s/%s@%s]" "method" "user@email" "host"))) (should (string-equal - (file-remote-p - "/[method/user@email@host]" 'method) "method")) + (file-remote-p "/[method/user@email@host]" 'method) "method")) (should (string-equal - (file-remote-p - "/[method/user@email@host]" 'user) "user@email")) + (file-remote-p "/[method/user@email@host]" 'user) + "user@email")) (should (string-equal (file-remote-p "/[method/user@email@host]" 'host) "host")) (should (string-equal @@ -1505,11 +1506,10 @@ Also see `ignore'." (file-remote-p "/[/user@host#1234]") (format "/[%s/%s@%s]" "default-method" "user" "host#1234"))) (should (string-equal - (file-remote-p - "/[/user@host#1234]" 'method) "default-method")) + (file-remote-p "/[/user@host#1234]" 'method) + "default-method")) (should (string-equal - (file-remote-p - "/[/user@host#1234]" 'user) "user")) + (file-remote-p "/[/user@host#1234]" 'user) "user")) (should (string-equal (file-remote-p "/[/user@host#1234]" 'host) "host#1234")) (should (string-equal @@ -1535,11 +1535,10 @@ Also see `ignore'." (file-remote-p "/[-/user@host#1234]") (format "/[%s/%s@%s]" "default-method" "user" "host#1234"))) (should (string-equal - (file-remote-p - "/[-/user@host#1234]" 'method) "default-method")) + (file-remote-p "/[-/user@host#1234]" 'method) + "default-method")) (should (string-equal - (file-remote-p - "/[-/user@host#1234]" 'user) "user")) + (file-remote-p "/[-/user@host#1234]" 'user) "user")) (should (string-equal (file-remote-p "/[-/user@host#1234]" 'host) "host#1234")) (should (string-equal @@ -1569,8 +1568,7 @@ Also see `ignore'." (should (string-equal (file-remote-p "/[method/user@host#1234]" 'user) "user")) (should (string-equal - (file-remote-p - "/[method/user@host#1234]" 'host) "host#1234")) + (file-remote-p "/[method/user@host#1234]" 'host) "host#1234")) (should (string-equal (file-remote-p "/[method/user@host#1234]" 'localname) "")) (should (string-equal @@ -1595,8 +1593,7 @@ Also see `ignore'." (file-remote-p "/[/user@1.2.3.4]") (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4"))) (should (string-equal - (file-remote-p - "/[/user@1.2.3.4]" 'method) "default-method")) + (file-remote-p "/[/user@1.2.3.4]" 'method) "default-method")) (should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'user) "user")) (should (string-equal @@ -1624,8 +1621,7 @@ Also see `ignore'." (file-remote-p "/[-/user@1.2.3.4]") (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4"))) (should (string-equal - (file-remote-p - "/[-/user@1.2.3.4]" 'method) "default-method")) + (file-remote-p "/[-/user@1.2.3.4]" 'method) "default-method")) (should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'user) "user")) (should (string-equal @@ -2299,9 +2295,9 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Check `directory-abbrev-alist' abbreviation. (let ((directory-abbrev-alist - `((,(concat "\\`" (regexp-quote home-dir) "/foo") + `((,(rx bos (literal home-dir) "/foo") . ,(concat home-dir "/f")) - (,(concat "\\`" (regexp-quote remote-host) "/nowhere") + (,(rx bos (literal remote-host) "/nowhere") . ,(concat remote-host "/nw"))))) (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) (concat remote-host-nohop "~/f/bar"))) @@ -2514,8 +2510,8 @@ This checks also `file-name-as-directory', `file-name-directory', (string-match-p (if (and (null noninteractive) (or (eq visit t) (null visit) (stringp visit))) - (format "^Wrote %s\n\\'" (regexp-quote tmp-name)) - "^\\'") + (rx bol "Wrote " (literal tmp-name) "\n" eos) + (rx bos)) tramp--test-messages)))))) ;; We do not test lockname here. See @@ -3215,38 +3211,40 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (with-temp-buffer (insert-directory tmp-name1 nil) (goto-char (point-min)) - (should (looking-at-p (regexp-quote tmp-name1)))) + (should (looking-at-p (rx (literal tmp-name1))))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) nil) (goto-char (point-min)) (should (looking-at-p - (regexp-quote (file-name-as-directory tmp-name1))))) + (rx (literal (file-name-as-directory tmp-name1)))))) (with-temp-buffer (insert-directory tmp-name1 "-al") (goto-char (point-min)) (should - (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1))))) + (looking-at-p (rx bol (+ nonl) " " (literal tmp-name1) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al") (goto-char (point-min)) (should - (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1))))) - (let ((directory-files (directory-files tmp-name1))) - (with-temp-buffer - (insert-directory - (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) - (goto-char (point-min)) - (should - (looking-at-p - (concat + (looking-at-p + (rx bol (+ nonl) " " (literal tmp-name1) "/" eol)))) + (with-temp-buffer + (insert-directory + (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) + (goto-char (point-min)) + (should + (looking-at-p + (rx-to-string + `(: ;; There might be a summary line. - "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?" + (? "total" (+ nonl) (+ digit) (? " ") + (? (any "EGKMPTYZk")) (? "i") (? "B") "\n") ;; We don't know in which order ".", ".." and "foo" appear. - (format - "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}" - (regexp-opt directory-files) - (length directory-files))))))) + (= ,(length (directory-files tmp-name1)) + (+ nonl) " " + (regexp ,(regexp-opt (directory-files tmp-name1))) + (? " ->" (+ nonl)) "\n")))))) ;; Check error cases. (when (and (tramp--test-supports-set-file-modes-p) @@ -3274,7 +3272,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (ert-deftest tramp-test17-dired-with-wildcards () "Check `dired' with wildcards." ;; `separate' syntax and IPv6 host name syntax do not work. - (skip-unless (not (string-match-p "\\[" ert-remote-temporary-file-directory))) + (skip-unless + (not (string-match-p (rx "[") ert-remote-temporary-file-directory))) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-rsync-p))) @@ -3313,15 +3312,15 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name1 ert-remote-temporary-file-directory)))) + (rx (literal + (file-relative-name + tmp-name1 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name2 ert-remote-temporary-file-directory))))) + (rx (literal + (file-relative-name + tmp-name2 ert-remote-temporary-file-directory)))))) (kill-buffer buffer) ;; Check for expanded directory and file names. @@ -3333,16 +3332,16 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name3 ert-remote-temporary-file-directory)))) + (rx (literal + (file-relative-name + tmp-name3 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name4 - ert-remote-temporary-file-directory))))) + (rx (literal + (file-relative-name + tmp-name4 + ert-remote-temporary-file-directory)))))) (kill-buffer buffer) ;; Check for special characters. @@ -3361,16 +3360,16 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name3 ert-remote-temporary-file-directory)))) + (rx (literal + (file-relative-name + tmp-name3 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name4 - ert-remote-temporary-file-directory))))) + (rx (literal + (file-relative-name + tmp-name4 + ert-remote-temporary-file-directory)))))) (kill-buffer buffer)) ;; Cleanup. @@ -3420,7 +3419,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (string-equal (dired-get-filename 'no-dir 'no-error) (file-name-nondirectory tmp-name2))) - (should-not (re-search-forward "dired" nil t)) + (should-not (search-forward "dired" nil t)) ;; The copied file has been inserted the line before. (forward-line -1) (should @@ -3593,12 +3592,16 @@ This tests also `access-file', `file-readable-p', (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-stat tramp-test-vec)) - (let ((default-directory ert-remote-temporary-file-directory) - (ert-test (ert-get-test ',test)) - (tramp-connection-properties - (cons '(nil "perl" nil) - tramp-connection-properties))) - (funcall (ert-test-body ert-test))))) + (if-let ((default-directory ert-remote-temporary-file-directory) + (ert-test (ert-get-test ',test)) + (result (ert-test-most-recent-result ert-test)) + (tramp-connection-properties + (cons '(nil "perl" nil) + tramp-connection-properties))) + (progn + (skip-unless (< (ert-test-result-duration result) 300)) + (funcall (ert-test-body ert-test))) + (ert-skip (format "Test `%s' must run before" ',test))))) (defmacro tramp--test-deftest-with-perl (test) "Define ert `TEST-with-perl'." @@ -3612,15 +3615,19 @@ This tests also `access-file', `file-readable-p', (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (tramp-get-remote-perl tramp-test-vec)) - (let ((default-directory ert-remote-temporary-file-directory) - (ert-test (ert-get-test ',test)) - (tramp-connection-properties - (append - '((nil "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (nil "readlink" nil)) - tramp-connection-properties))) - (funcall (ert-test-body ert-test))))) + (if-let ((default-directory ert-remote-temporary-file-directory) + (ert-test (ert-get-test ',test)) + (result (ert-test-most-recent-result ert-test)) + (tramp-connection-properties + (append + '((nil "stat" nil) + ;; See `tramp-sh-handle-file-truename'. + (nil "readlink" nil)) + tramp-connection-properties))) + (progn + (skip-unless (< (ert-test-result-duration result) 300)) + (funcall (ert-test-body ert-test))) + (ert-skip (format "Test `%s' must run before" ',test))))) (defmacro tramp--test-deftest-with-ls (test) "Define ert `TEST-with-ls'." @@ -3633,16 +3640,20 @@ This tests also `access-file', `file-readable-p', :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - (let ((default-directory ert-remote-temporary-file-directory) - (ert-test (ert-get-test ',test)) - (tramp-connection-properties - (append - '((nil "perl" nil) - (nil "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (nil "readlink" nil)) - tramp-connection-properties))) - (funcall (ert-test-body ert-test))))) + (if-let ((default-directory ert-remote-temporary-file-directory) + (ert-test (ert-get-test ',test)) + (result (ert-test-most-recent-result ert-test)) + (tramp-connection-properties + (append + '((nil "perl" nil) + (nil "stat" nil) + ;; See `tramp-sh-handle-file-truename'. + (nil "readlink" nil)) + tramp-connection-properties))) + (progn + (skip-unless (< (ert-test-result-duration result) 300)) + (funcall (ert-test-body ert-test))) + (ert-skip (format "Test `%s' must run before" ',test))))) (tramp--test-deftest-with-stat tramp-test18-file-attributes) @@ -3754,14 +3765,15 @@ They might differ only in time attributes or directory size." (tramp--test-file-attributes-equal-p (file-attributes (car elt)) (cdr elt)))) - (setq attr (directory-files-and-attributes tmp-name2 nil "\\`b")) + (setq attr (directory-files-and-attributes + tmp-name2 nil (rx bos "b"))) (should (equal (mapcar #'car attr) '("bar" "boz"))) ;; Check the COUNT arg. It exists since Emacs 28. (when (tramp--test-emacs28-p) (with-no-warnings (setq attr (directory-files-and-attributes - tmp-name2 nil "\\`b" nil nil 1)) + tmp-name2 nil (rx bos "b") nil nil 1)) (should (equal (mapcar #'car attr) '("bar")))))) ;; Cleanup. @@ -3867,8 +3879,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." `(condition-case err (progn ,@body) (file-error - (unless (string-match-p "^error with add-name-to-file" - (error-message-string err)) + (unless (string-prefix-p "error with add-name-to-file" + (error-message-string err)) (signal (car err) (cdr err)))))) (ert-deftest tramp-test21-file-links () @@ -4598,7 +4610,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (defun tramp--test-shell-file-name () "Return default remote shell." - (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")) + (if (file-exists-p + (concat + (file-remote-p ert-remote-temporary-file-directory) "/system/bin/sh")) + "/system/bin/sh" "/bin/sh")) (ert-deftest tramp-test28-process-file () "Check `process-file'." @@ -4638,7 +4653,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let ((process-file-return-signal-string t)) (should (string-match-p - "Interrupt\\|Signal 2" + (rx (| "Interrupt" "Signal 2")) (process-file (tramp--test-shell-file-name) nil nil nil "-c" "kill -2 $$"))))) @@ -4718,7 +4733,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (insert-file-contents tmp-name) (should (string-match-p - "cat:.* No such file or directory" (buffer-string))) + (rx "cat:" (* nonl) " No such file or directory") + (buffer-string))) (should-not (get-buffer-window (current-buffer) t)) (delete-file tmp-name)))) @@ -4868,8 +4884,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; On macOS, there is always newline conversion. ;; "telnet" converts \r to <CR><NUL> if `crlf' ;; flag is FALSE. See telnet(1) man page. - "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" - "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") + (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") + (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) (buffer-string)))) ;; Cleanup. @@ -5066,7 +5082,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (with-timeout (10 (tramp--test-timeout-handler)) (while (accept-process-output proc 0 nil t))) ;; On some MS Windows systems, it returns "unknown signal". - (should (string-match-p "unknown signal\\|killed" (buffer-string)))) + (should + (string-match-p + (rx (| "unknown signal" "killed")) (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) @@ -5099,7 +5117,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (delete-process proc) (should (string-match-p - "cat:.* No such file or directory" (buffer-string))))) + (rx "cat:" (* nonl) " No such file or directory") + (buffer-string))))) ;; Cleanup. (ignore-errors (delete-process proc)) @@ -5126,7 +5145,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (insert-file-contents tmp-name) (should (string-match-p - "cat:.* No such file or directory" (buffer-string))))) + (rx "cat:" (* nonl) " No such file or directory") + (buffer-string))))) ;; Cleanup. (ignore-errors (delete-process proc)) @@ -5177,8 +5197,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; On macOS, there is always newline conversion. ;; "telnet" converts \r to <CR><NUL> if `crlf' ;; flag is FALSE. See telnet(1) man page. - "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" - "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") + (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") + (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) (buffer-string)))) ;; Cleanup. @@ -5657,7 +5677,7 @@ INPUT, if non-nil, is a string sent to the process." ;; Variable is set. (should (string-match-p - (regexp-quote envvar) + (rx (literal envvar)) (funcall this-shell-command-to-string "set")))) (unless (tramp-direct-async-process-p) @@ -5684,7 +5704,7 @@ INPUT, if non-nil, is a string sent to the process." ;; Variable is unset. (should-not (string-match-p - (regexp-quote envvar) + (rx (literal envvar)) ;; We must remove PS1, the output is truncated otherwise. ;; We must suppress "_=VAR...". (funcall @@ -5836,7 +5856,7 @@ INPUT, if non-nil, is a string sent to the process." (with-timeout (10) (while (accept-process-output (get-buffer-process (current-buffer)) nil nil t))) - (should (string-match-p "^foo$" (buffer-string))))) + (should (string-match-p (rx bol "foo" eol) (buffer-string))))) ;; Cleanup. (put 'explicit-shell-file-name 'permanent-local nil) @@ -6354,7 +6374,7 @@ INPUT, if non-nil, is a string sent to the process." ;; When `lock-file-name-transforms' is set, another lock ;; file is used. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (let ((lock-file-name-transforms `((".*" ,tmp-name2)))) + (let ((lock-file-name-transforms `((,(rx (* nonl)) ,tmp-name2)))) (should (string-equal (with-no-warnings (make-lock-file-name tmp-name1)) @@ -6480,10 +6500,12 @@ INPUT, if non-nil, is a string sent to the process." (insert "bar") (when create-lockfiles (should (string-match-p - (format - "^%s changed on disk; really edit the buffer\\?" - (if (tramp--test-crypt-p) - ".+" (file-name-nondirectory tmp-name))) + (rx-to-string + `(: bol + ,(if (tramp--test-crypt-p) + '(+ nonl) + (file-name-nondirectory tmp-name)) + " changed on disk; really edit the buffer?")) captured-messages)) (should (file-locked-p tmp-name))))) @@ -6574,7 +6596,7 @@ This is used in tests which we don't want to tag :body nil :tags '(:tramp-asynchronous-processes)))) ;; tramp-adb.el cannot apply multi-byte commands. (not (and (tramp--test-adb-p) - (string-match-p "[[:multibyte:]]" default-directory))))) + (string-match-p (rx multibyte) default-directory))))) (defun tramp--test-crypt-p () "Check, whether the remote directory is encrypted." @@ -6599,8 +6621,8 @@ completely." "Check, whether an FTP-like method is used. This does not support globbing characters in file names (yet)." ;; Globbing characters are ??, ?* and ?\[. - (string-match-p - "ftp$" (file-remote-p ert-remote-temporary-file-directory 'method))) + (string-suffix-p + "ftp" (file-remote-p ert-remote-temporary-file-directory 'method))) (defun tramp--test-fuse-p () "Check, whether an FUSE file system isused." @@ -6623,7 +6645,7 @@ If optional METHOD is given, it is checked first." Several special characters do not work properly there." ;; We must refill the cache. `file-truename' does it. (file-truename ert-remote-temporary-file-directory) - (ignore-errors (tramp-check-remote-uname tramp-test-vec "^HP-UX"))) + (ignore-errors (tramp-check-remote-uname tramp-test-vec (rx bol "HP-UX")))) (defun tramp--test-ksh-p () "Check, whether the remote shell is ksh. @@ -6631,8 +6653,9 @@ ksh93 makes some strange conversions of non-latin characters into a $'' syntax." ;; We must refill the cache. `file-truename' does it. (file-truename ert-remote-temporary-file-directory) - (string-match-p - "ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" ""))) + (string-suffix-p + "ksh" + (tramp-get-connection-property tramp-test-vec "remote-shell" ""))) (defun tramp--test-macos-p () "Check, whether the remote host runs macOS." @@ -6680,7 +6703,7 @@ Additionally, ls does not support \"--dired\"." "Check, whether the method needs a share." (and (tramp--test-gvfs-p) (string-match-p - "^\\(afp\\|davs?\\|smb\\)$" + (rx bol (or "afp" (: "dav" (opt "s")) "smb") eol) (file-remote-p ert-remote-temporary-file-directory 'method)))) (defun tramp--test-sshfs-p () @@ -6732,7 +6755,7 @@ This requires restrictions of file name syntax." ;; Not all tramp-gvfs.el methods support changing the file mode. (and (tramp--test-gvfs-p) - (string-match-p + (string-suffix-p "ftp" (file-remote-p ert-remote-temporary-file-directory 'method))))) (defun tramp--test-check-files (&rest files) @@ -6881,14 +6904,14 @@ This requires restrictions of file name syntax." (should (string-equal (caar (directory-files-and-attributes - file1 nil (regexp-quote elt1))) + file1 nil (rx (literal elt1)))) elt1)) (should (string-equal (funcall (if quoted #'tramp-compat-file-name-quote #'identity) (cadr (car (directory-files-and-attributes - file1 nil (regexp-quote elt1))))) + file1 nil (rx (literal elt1)))))) (file-remote-p (file-truename file2) 'localname))) (delete-file file3) (should-not (file-exists-p file3)))) @@ -6943,10 +6966,8 @@ This requires restrictions of file name syntax." (goto-char (point-min)) (should (re-search-forward - (format - "^%s=%s$" - (regexp-quote envvar) - (regexp-quote (getenv envvar)))))))))) + (rx bol (literal envvar) + "=" (literal (getenv envvar)) eol)))))))) ;; Cleanup. (ignore-errors (kill-buffer buffer)) @@ -7078,7 +7099,7 @@ This requires restrictions of file name syntax." ;; ?\n and ?/ shouldn't be part of any file name. ?\t, ;; ?. and ?? do not work for "smb" method. " " does not ;; work at begin or end of the string for MS Windows. - (replace-regexp-in-string "[ \t\n/.?]" "" x))) + (replace-regexp-in-string (rx (any " \t\n/.?")) "" x))) language-info-alist))))))) (tramp--test-deftest-with-stat tramp-test42-utf8) @@ -7461,7 +7482,7 @@ process sentinels. They shall not disturb each other." ert-remote-temporary-file-directory))) (should (string-match-p - "Tramp loaded: t[\n\r]+" + (rx "Tramp loaded: t" (+ (any "\n\r"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7488,9 +7509,9 @@ process sentinels. They shall not disturb each other." (dolist (tm '(t nil)) (should (string-match-p - (format - "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+" - tm) + (rx "Tramp loaded: nil" (+ (any "\n\r")) + "Tramp loaded: nil" (+ (any "\n\r")) + "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7535,11 +7556,10 @@ process sentinels. They shall not disturb each other." (tramp-cleanup-all-connections))")) (should (string-match-p - (format - "Loading %s" - (regexp-quote - (expand-file-name - "tramp-cmds" (file-name-directory (locate-library "tramp"))))) + (rx "Loading " + (literal + (expand-file-name + "tramp-cmds" (file-name-directory (locate-library "tramp"))))) (shell-command-to-string (format "%s -batch -Q -L %s -l tramp-sh --eval %s" @@ -7580,11 +7600,13 @@ Since it unloads Tramp, it shall be the last test to run." (and (or (and (boundp x) (null (local-variable-if-set-p x))) (and (functionp x) (null (autoloadp (symbol-function x)))) (macrop x)) - (string-match-p "^tramp" (symbol-name x)) + (string-prefix-p "tramp" (symbol-name x)) ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. (not (eq 'tramp-completion-mode x)) - (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x))) - (not (string-match-p "unload-hook$" (symbol-name x))) + (not (string-match-p + (rx bol "tramp" (? "-archive") (** 1 2 "-") "test") + (symbol-name x))) + (not (string-suffix-p "unload-hook" (symbol-name x))) (not (get x 'tramp-autoload)) (ert-fail (format "`%s' still bound" x))))) @@ -7594,7 +7616,7 @@ Since it unloads Tramp, it shall be the last test to run." (mapatoms (lambda (x) (and (functionp x) (null (autoloadp (symbol-function x))) - (string-match-p "tramp-file-name" (symbol-name x)) + (string-prefix-p "tramp-file-name" (symbol-name x)) (ert-fail (format "Structure function `%s' still exists" x))))) ;; There shouldn't be left a hook function containing a Tramp @@ -7602,8 +7624,9 @@ Since it unloads Tramp, it shall be the last test to run." (mapatoms (lambda (x) (and (boundp x) - (string-match-p "-\\(hook\\|function\\)s?$" (symbol-name x)) - (not (string-match-p "unload-hook$" (symbol-name x))) + (string-match-p + (rx "-" (| "hook" "function") (? "s") eol) (symbol-name x)) + (not (string-suffix-p "unload-hook" (symbol-name x))) (consp (symbol-value x)) (ignore-errors (all-completions "tramp" (symbol-value x))) (ert-fail (format "Hook `%s' still contains Tramp function" x))))) @@ -7614,7 +7637,7 @@ Since it unloads Tramp, it shall be the last test to run." (and (functionp x) (advice-mapc (lambda (fun _symbol) - (and (string-match-p "^tramp" (symbol-name fun)) + (and (string-prefix-p "tramp" (symbol-name fun)) (ert-fail (format "Function `%s' still contains Tramp advice" x)))) x)))) @@ -7631,7 +7654,7 @@ If INTERACTIVE is non-nil, the tests are run interactively." (interactive "p") (funcall (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch) - "^tramp")) + (rx bol "tramp"))) ;; TODO: diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 8e4dfa8bb83..e73be0db504 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -183,6 +183,16 @@ (call-interactively #'eval-last-sexp) (should (equal (current-message) "66 (#o102, #x42, ?B)")))))) +;;; eval-defun + +(ert-deftest eval-defun-prints-edebug-when-instrumented () + (skip-unless (not noninteractive)) + (with-temp-buffer + (let ((current-prefix-arg '(4))) + (erase-buffer) (insert "(defun foo ())") (message nil) + (call-interactively #'eval-defun) + (should (equal (current-message) "Edebug: foo"))))) + ;;; eldoc (defun elisp-mode-tests--face-propertized-string (string) @@ -1084,7 +1094,7 @@ evaluation of BODY." (insert "f-test-compl") (completion-at-point) (goto-char (point-min)) - (should (search-forward "f-test-complete-me" (line-end-position) t)) + (should (search-forward "f-test-complete-me" (pos-eol) t)) (goto-char (point-min)) (should (string= (symbol-name (read (current-buffer))) "elisp--foo-test-complete-me")) diff --git a/test/lisp/progmodes/f90-tests.el b/test/lisp/progmodes/f90-tests.el index 3fe5eecd1b2..b857a25bf2a 100644 --- a/test/lisp/progmodes/f90-tests.el +++ b/test/lisp/progmodes/f90-tests.el @@ -285,14 +285,14 @@ real :: x end") (f90-indent-line) (should (equal " function foo" - (buffer-substring (point) (line-end-position)))) + (buffer-substring (point) (pos-eol)))) (goto-char (point-max)) (insert "\nmodule subroutine bar(x) real :: x end") (f90-indent-line) (should (equal " subroutine bar" - (buffer-substring (point) (line-end-position)))))) + (buffer-substring (point) (pos-eol)))))) ;;; f90-tests.el ends here diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hideshow-tests.el new file mode 100644 index 00000000000..ee2a0c7c4c1 --- /dev/null +++ b/test/lisp/progmodes/hideshow-tests.el @@ -0,0 +1,268 @@ +;;; hideshow-tests.el --- Test suite for hideshow.el -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'hideshow) + +;; Dependencies for testing: +(require 'cc-mode) + + +(defmacro hideshow-tests-with-temp-buffer (mode contents &rest body) + "Create a `hs-minor-mode' enabled MODE temp buffer with CONTENTS. +BODY is code to be executed within the temp buffer. Point is +always located at the beginning of buffer." + (declare (indent 1) (debug t)) + `(with-temp-buffer + (,mode) + (hs-minor-mode 1) + (insert ,contents) + (goto-char (point-min)) + ,@body)) + +(defun hideshow-tests-look-at (string &optional num restore-point) + "Move point at beginning of STRING in the current buffer. +Optional argument NUM defaults to 1 and is an integer indicating +how many occurrences must be found, when positive the search is +done forwards, otherwise backwards. When RESTORE-POINT is +non-nil the point is not moved but the position found is still +returned. When searching forward and point is already looking at +STRING, it is skipped so the next STRING occurrence is selected." + (let* ((num (or num 1)) + (starting-point (point)) + (string (regexp-quote string)) + (search-fn (if (> num 0) #'re-search-forward #'re-search-backward)) + (deinc-fn (if (> num 0) #'1- #'1+)) + (found-point)) + (prog2 + (catch 'exit + (while (not (= num 0)) + (when (and (> num 0) + (looking-at string)) + ;; Moving forward and already looking at STRING, skip it. + (forward-char (length (match-string-no-properties 0)))) + (and (not (funcall search-fn string nil t)) + (throw 'exit t)) + (when (> num 0) + ;; `re-search-forward' leaves point at the end of the + ;; occurrence, move back so point is at the beginning + ;; instead. + (forward-char (- (length (match-string-no-properties 0))))) + (setq + num (funcall deinc-fn num) + found-point (point)))) + found-point + (and restore-point (goto-char starting-point))))) + +(defun hideshow-tests-visible-string (&optional min max) + "Return the buffer string excluding invisible overlays. +Argument MIN and MAX delimit the region to be returned and +default to `point-min' and `point-max' respectively." + (let* ((min (or min (point-min))) + (max (or max (point-max))) + (buffer-contents (buffer-substring-no-properties min max)) + (overlays + (sort (overlays-in min max) + (lambda (a b) + (let ((overlay-end-a (overlay-end a)) + (overlay-end-b (overlay-end b))) + (> overlay-end-a overlay-end-b)))))) + (with-temp-buffer + (insert buffer-contents) + (dolist (overlay overlays) + (if (overlay-get overlay 'invisible) + (delete-region (overlay-start overlay) + (overlay-end overlay)))) + (buffer-substring-no-properties (point-min) (point-max))))) + +(ert-deftest hideshow-hide-block-1 () + "Should hide current block." + (let ((contents " +int +main() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (hideshow-tests-look-at "printf") + (hs-hide-block) + (should (string= + (hideshow-tests-visible-string) + " +int +main() +{} +")) + (hs-show-block) + (should (string= (hideshow-tests-visible-string) contents))))) + +(ert-deftest hideshow-hide-all-1 () + "Should hide all blocks and comments." + (let ((contents " +/* + Comments +*/ + +int +main() +{ + sub(); +} + +void +sub() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (hs-hide-all) + (should (string= + (hideshow-tests-visible-string) + " +/* + +int +main() +{} + +void +sub() +{} +")) + (hs-show-all) + (should (string= (hideshow-tests-visible-string) contents))))) + +(ert-deftest hideshow-hide-all-2 () + "Should not hide comments when `hs-hide-comments-when-hiding-all' is nil." + (let ((contents " +/* + Comments +*/ + +int +main() +{ + sub(); +} + +void +sub() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (let ((hs-hide-comments-when-hiding-all nil)) + (hs-hide-all)) + (should (string= + (hideshow-tests-visible-string) + " +/* + Comments +*/ + +int +main() +{} + +void +sub() +{} +")) + (hs-show-all) + (should (string= (hideshow-tests-visible-string) contents))))) + +(ert-deftest hideshow-hide-level-1 () + "Should hide 1st level blocks." + (hideshow-tests-with-temp-buffer + c-mode + " +/* + Comments +*/ + +int +main(int argc, char **argv) +{ + if (argc > 1) { + printf(\"Hello\\n\"); + } +} +" + (hs-hide-level 1) + (should (string= + (hideshow-tests-visible-string) + " +/* + Comments +*/ + +int +main(int argc, char **argv) +{} +")))) + +(ert-deftest hideshow-hide-level-2 () + "Should hide 2nd level blocks." + (hideshow-tests-with-temp-buffer + c-mode + " +/* + Comments +*/ + +int +main(int argc, char **argv) +{ + if (argc > 1) { + printf(\"Hello\\n\"); + } +} +" + (hs-hide-level 2) + (should (string= + (hideshow-tests-visible-string) + " +/* + Comments +*/ + +int +main(int argc, char **argv) +{ + if (argc > 1) {} +} +")))) + +(provide 'hideshow-tests) + +;;; hideshow-tests.el ends here diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 9e8fa7f5520..906f7eca7de 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -108,6 +108,20 @@ STRING, it is skipped so the next STRING occurrence is selected." while pos collect (cons pos (get-text-property pos 'face)))) +(defun python-tests-assert-faces-after-change (content faces search replace) + "Assert that font faces for CONTENT are equal to FACES after change. +All occurrences of SEARCH are changed to REPLACE." + (python-tests-with-temp-buffer + content + ;; Force enable font-lock mode without jit-lock. + (rename-buffer "*python-font-lock-test*" t) + (let (noninteractive font-lock-support-mode) + (font-lock-mode)) + (while + (re-search-forward search nil t) + (replace-match replace)) + (should (equal faces (python-tests-get-buffer-faces))))) + (defun python-tests-self-insert (char-or-str) "Call `self-insert-command' for chars in CHAR-OR-STR." (let ((chars @@ -226,6 +240,13 @@ aliqua." "def 1func():" '((1 . font-lock-keyword-face) (4)))) +(ert-deftest python-font-lock-keywords-level-1-3 () + (python-tests-assert-faces + "def \\ + func():" + '((1 . font-lock-keyword-face) (4) + (15 . font-lock-function-name-face) (19)))) + (ert-deftest python-font-lock-assignment-statement-1 () (python-tests-assert-faces "a, b, c = 1, 2, 3" @@ -380,6 +401,98 @@ def f(x: CustomInt) -> CustomInt: (128 . font-lock-builtin-face) (131) (144 . font-lock-keyword-face) (150)))) +(ert-deftest python-font-lock-assignment-statement-multiline-1 () + (python-tests-assert-faces-after-change + " +[ + a, + b +] # ( + 1, + 2 +) +" + '((1) + (8 . font-lock-variable-name-face) (9) + (15 . font-lock-variable-name-face) (16)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-2 () + (python-tests-assert-faces-after-change + " +[ + *a +] # 5, 6 +" + '((1) + (9 . font-lock-variable-name-face) (10)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-3 () + (python-tests-assert-faces-after-change + "a\\ + ,\\ + b\\ + ,\\ + c\\ + #\\ + 1\\ + ,\\ + 2\\ + ,\\ + 3" + '((1 . font-lock-variable-name-face) (2) + (15 . font-lock-variable-name-face) (16) + (29 . font-lock-variable-name-face) (30)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-4 () + (python-tests-assert-faces-after-change + "a\\ + :\\ + int\\ + #\\ + 5" + '((1 . font-lock-variable-name-face) (2) + (15 . font-lock-builtin-face) (18)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-5 () + (python-tests-assert-faces-after-change + "(\\ + a\\ +)\\ + #\\ + 5\\ + ;\\ + (\\ + b\\ + )\\ + #\\ + 6" + '((1) + (8 . font-lock-variable-name-face) (9) + (46 . font-lock-variable-name-face) (47)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-6 () + (python-tests-assert-faces-after-change + "( + a +)\\ + #\\ + 5\\ + ;\\ + ( + b + )\\ + #\\ + 6" + '((1) + (7 . font-lock-variable-name-face) (8) + (43 . font-lock-variable-name-face) (44)) + "#" "=")) + (ert-deftest python-font-lock-escape-sequence-string-newline () (python-tests-assert-faces "'\\n' @@ -1137,6 +1250,25 @@ def delete_all_things(): :after-backslash-dotted-continuation)) (should (= (python-indent-calculate-indentation) 16)))) +(ert-deftest python-indent-after-backslash-6 () + "Backslash continuation from for block." + (python-tests-with-temp-buffer + " +for long_variable_name \\ + in (1, 2): + print(long_variable_name) +" + (python-tests-look-at "for long_variable_name \\") + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (python-tests-look-at "in (1, 2):") + (should (eq (car (python-indent-context)) + :after-backslash-block-continuation)) + (should (= (python-indent-calculate-indentation) 8)) + (python-tests-look-at "print(long_variable_name)") + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 4)))) + (ert-deftest python-indent-block-enders-1 () "Test de-indentation for pass keyword." (python-tests-with-temp-buffer @@ -1507,7 +1639,7 @@ a = ( " (python-tests-look-at "- bar") (should (eq (car (python-indent-context)) :inside-string)) - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ",") (should (= (current-indentation) 0)))) @@ -1522,7 +1654,7 @@ a = ( " (python-tests-look-at "- bar'''") (should (eq (car (python-indent-context)) :inside-string)) - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ",") (should (= (current-indentation) 0)))) @@ -1536,7 +1668,7 @@ def a(): def b() " (python-tests-look-at "def b()") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ":") (should (= (current-indentation) 0)))) @@ -1550,7 +1682,7 @@ if do: outside " (python-tests-look-at "else") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ":") (should (= (current-indentation) 0)) (python-tests-look-at "outside") @@ -1567,7 +1699,7 @@ if do: that) " (python-tests-look-at "that)") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ":") (python-tests-look-at "elif" -1) (should (= (current-indentation) 0)) @@ -1592,7 +1724,7 @@ def f(): else " (python-tests-look-at "else") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ":") (python-tests-look-at "else" -1) (should (= (current-indentation) 4)))) @@ -1852,7 +1984,7 @@ class C: (expected-mark-beginning-position (progn (python-tests-look-at "def __init__(self):") - (1- (line-beginning-position)))) + (1- (pos-bol)))) (expected-mark-end-position-1 (save-excursion (python-tests-look-at "self.b = 'b'") @@ -1909,7 +2041,7 @@ class C: (progn (python-tests-look-at "def fun(self):") (python-tests-look-at "(self):") - (1- (line-beginning-position)))) + (1- (pos-bol)))) (expected-mark-end-position (save-excursion (python-tests-look-at "return self.b") @@ -1934,7 +2066,7 @@ def foo(x): (let ((expected-mark-beginning-position (progn (python-tests-look-at "def foo(x):") - (1- (line-beginning-position)))) + (1- (pos-bol)))) (expected-mark-end-position (point-max))) (python-tests-look-at "return bar") (python-mark-defun 1) @@ -1954,7 +2086,7 @@ def \\ (expected-mark-beginning-position (progn (python-tests-look-at "def ") - (1- (line-beginning-position)))) + (1- (pos-bol)))) (expected-mark-end-position (save-excursion (python-tests-look-at "return x") @@ -2306,21 +2438,21 @@ def decoratorFunctionWithArguments(arg1, arg2, arg3): (point)) (save-excursion (python-tests-look-at "return wwrap") - (line-beginning-position)))) + (pos-bol)))) (should (= (save-excursion (python-tests-look-at "def wrapped_f(*args):") (python-nav-end-of-defun) (point)) (save-excursion (python-tests-look-at "return wrapped_f") - (line-beginning-position)))) + (pos-bol)))) (should (= (save-excursion (python-tests-look-at "f(*args)") (python-nav-end-of-defun) (point)) (save-excursion (python-tests-look-at "return wrapped_f") - (line-beginning-position)))))) + (pos-bol)))))) (ert-deftest python-nav-end-of-defun-3 () (python-tests-with-temp-buffer @@ -2633,14 +2765,14 @@ string (point)) (save-excursion (python-tests-look-at "789") - (line-end-position)))) + (pos-eol)))) (python-tests-look-at "v2 =") (should (= (save-excursion (python-nav-end-of-statement) (point)) (save-excursion (python-tests-look-at "value4)") - (line-end-position)))) + (pos-eol)))) (python-tests-look-at "v3 =") (should (= (save-excursion (python-nav-end-of-statement) @@ -2648,7 +2780,7 @@ string (save-excursion (python-tests-look-at "'continue previous line')") - (line-end-position)))) + (pos-eol)))) (python-tests-look-at "v4 =") (should (= (save-excursion (python-nav-end-of-statement) @@ -2872,21 +3004,21 @@ def decoratorFunctionWithArguments(arg1, arg2, arg3): (point)) (save-excursion (python-tests-look-at "return wrapped_f") - (line-end-position)))) + (pos-eol)))) (end-of-line) (should (= (save-excursion (python-nav-end-of-block) (point)) (save-excursion (python-tests-look-at "return wrapped_f") - (line-end-position)))) + (pos-eol)))) (python-tests-look-at "f(*args)") (should (= (save-excursion (python-nav-end-of-block) (point)) (save-excursion (python-tests-look-at "print 'After f(*args)'") - (line-end-position)))))) + (pos-eol)))))) (ert-deftest python-nav-end-of-block-2 () "Ensure that `python-nav-end-of-block' does not enter an infinite loop." @@ -3176,11 +3308,11 @@ if x: \tabcdefg " (python-tests-look-at "abcdefg") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) "\tabcdef"))))) (ert-deftest python-indent-dedent-line-backspace-3 () @@ -3193,27 +3325,27 @@ if x: \t abcdefg " (python-tests-look-at "abcdefg") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) "\t abcdef")) (back-to-indentation) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) "\tabcdef")) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) " abcdef")) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) "abcdef"))))) (ert-deftest python-bob-infloop-avoid () @@ -4226,11 +4358,11 @@ map(codecs.open('somefile' " (python-tests-look-at "ap(xx") (should (string= (python-eldoc--get-symbol-at-point) "map")) - (goto-char (line-end-position)) + (goto-char (pos-eol)) (should (string= (python-eldoc--get-symbol-at-point) "map")) (python-tests-look-at "('somefile'") (should (string= (python-eldoc--get-symbol-at-point) "map")) - (goto-char (line-end-position)) + (goto-char (pos-eol)) (should (string= (python-eldoc--get-symbol-at-point) "codecs.open")))) (ert-deftest python-eldoc--get-symbol-at-point-2 () @@ -4743,7 +4875,7 @@ def long_function_name( (should (not (python-info-beginning-of-statement-p))) (python-tests-look-at "print (var_one)") (should (python-info-beginning-of-statement-p)) - (goto-char (line-beginning-position)) + (goto-char (pos-bol)) (should (not (python-info-beginning-of-statement-p))))) (ert-deftest python-info-beginning-of-statement-p-2 () @@ -4763,7 +4895,7 @@ if width == 0 and height == 0 and \\ (should (not (python-info-beginning-of-statement-p))) (python-tests-look-at "raise ValueError(") (should (python-info-beginning-of-statement-p)) - (goto-char (line-beginning-position)) + (goto-char (pos-bol)) (should (not (python-info-beginning-of-statement-p))))) (ert-deftest python-info-end-of-statement-p-1 () @@ -5598,6 +5730,39 @@ def \\ (should (not (python-info-looking-at-beginning-of-defun))) (should (not (python-info-looking-at-beginning-of-defun nil t))))) +(ert-deftest python-info-looking-at-beginning-of-block-1 () + (python-tests-with-temp-buffer + " +def f(): + if True: + pass + l = [x * 2 + for x in range(5) + if x < 3] +# if False: +\"\"\" +if 0: +\"\"\" +" + (python-tests-look-at "def f():") + (should (python-info-looking-at-beginning-of-block)) + (forward-char) + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if True:") + (should (python-info-looking-at-beginning-of-block)) + (forward-char) + (should (not (python-info-looking-at-beginning-of-block))) + (beginning-of-line) + (should (python-info-looking-at-beginning-of-block)) + (python-tests-look-at "for x") + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if x < 3") + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if False:") + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if 0:") + (should (not (python-info-looking-at-beginning-of-block))))) + (ert-deftest python-info-current-line-comment-p-1 () (python-tests-with-temp-buffer " @@ -6051,8 +6216,11 @@ class SomeClass: class SomeClass: def __init__(self, arg, kwarg=1): + def filter(self, nums): - def __str__(self):")))) + + def __str__(self): +")))) (or enabled (hs-minor-mode -1))))) (ert-deftest python-hideshow-hide-levels-2 () @@ -6098,6 +6266,165 @@ class SomeClass: ")))) (or enabled (hs-minor-mode -1))))) +(ert-deftest python-hideshow-hide-levels-3 () + "Should hide all blocks." + (python-tests-with-temp-buffer + " +def f(): + if 0: + l = [i for i in range(5) + if i < 3] + abc = o.match(1, 2, 3) + +def g(): + pass +" + (hs-minor-mode 1) + (hs-hide-level 1) + (should + (string= + (python-tests-visible-string) + " +def f(): + +def g(): +")))) + +(ert-deftest python-hideshow-hide-levels-4 () + "Should hide 2nd level block." + (python-tests-with-temp-buffer + " +def f(): + if 0: + l = [i for i in range(5) + if i < 3] + abc = o.match(1, 2, 3) + +def g(): + pass +" + (hs-minor-mode 1) + (hs-hide-level 2) + (should + (string= + (python-tests-visible-string) + " +def f(): + if 0: + +def g(): + pass +")))) + +(ert-deftest python-hideshow-hide-all-1 () + "Should hide all blocks." + (python-tests-with-temp-buffer + "if 0: + + aaa + l = [i for i in range(5) + if i < 3] + ccc + abc = o.match(1, 2, 3) + ddd + +def f(): + pass +" + (hs-minor-mode 1) + (hs-hide-all) + (should + (string= + (python-tests-visible-string) + "if 0: + +def f(): +")))) + +(ert-deftest python-hideshow-hide-all-2 () + "Should hide comments." + (python-tests-with-temp-buffer + " +# Multi line +# comment + +\"\"\" +# Multi line +# string +\"\"\" +" + (hs-minor-mode 1) + (hs-hide-all) + (should + (string= + (python-tests-visible-string) + " +# Multi line + +\"\"\" +# Multi line +# string +\"\"\" +")))) + +(ert-deftest python-hideshow-hide-all-3 () + "Should not hide comments when `hs-hide-comments-when-hiding-all' is nil." + (python-tests-with-temp-buffer + " +# Multi line +# comment + +\"\"\" +# Multi line +# string +\"\"\" +" + (hs-minor-mode 1) + (let ((hs-hide-comments-when-hiding-all nil)) + (hs-hide-all)) + (should + (string= + (python-tests-visible-string) + " +# Multi line +# comment + +\"\"\" +# Multi line +# string +\"\"\" +")))) + +(ert-deftest python-hideshow-hide-block-1 () + "Should hide current block." + (python-tests-with-temp-buffer + " +if 0: + + aaa + l = [i for i in range(5) + if i < 3] + ccc + abc = o.match(1, 2, 3) + ddd + +def f(): + pass +" + (hs-minor-mode 1) + (python-tests-look-at "ddd") + (forward-line) + (hs-hide-block) + (should + (string= + (python-tests-visible-string) + " +if 0: + +def f(): + pass +")))) + (ert-deftest python-tests--python-nav-end-of-statement--infloop () "Checks that `python-nav-end-of-statement' doesn't infloop in a @@ -6168,6 +6495,40 @@ buffer with overlapping strings." a = 1 "))) + +;;; Flymake + +(ert-deftest python-tests--flymake-command-output-pattern () + (pcase-let ((`(,patt ,line ,col ,type ,msg) + python-flymake-command-output-pattern)) + ;; Pyflakes output as of version 2.4.0 + (let ((output "<stdin>:12:34 'a.b.c as d' imported but unused")) + (string-match patt output) + (should (equal (match-string line output) "12")) + (when col (should (equal (match-string col output) "34"))) + (should (equal (match-string msg output) + "'a.b.c as d' imported but unused"))) + ;; Flake8 output as of version 4.0.1 + (let ((output "stdin:12:34: F401 'a.b.c as d' imported but unused")) + (string-match patt output) + (should (equal (match-string line output) "12")) + (when col (should (equal (match-string col output) "34"))) + (when type (should (equal (match-string type output) "F401"))) + (should (equal (match-string msg output) + (if type + "'a.b.c as d' imported but unused" + "F401 'a.b.c as d' imported but unused")))) + ;; Pylint output as of version 2.14.5 + (let ((output "stdin:12:34: W0611: Unused import a.b.c (unused-import)")) + (string-match patt output) + (should (equal (match-string line output) "12")) + (when col (should (equal (match-string col output) "34"))) + (when type (should (equal (match-string type output) "W0611"))) + (should (equal (match-string msg output) + (if type + "Unused import a.b.c (unused-import)" + "W0611: Unused import a.b.c (unused-import)")))))) + (provide 'python-tests) ;;; python-tests.el ends here diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index ef1e5c3eafc..23ec24840fb 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -378,7 +378,7 @@ Each element has the format: (goto-char (point-min)) (should (string-match "\\`2 matches for \"and\" in buffer: " (buffer-substring-no-properties - (point) (line-end-position))))))) + (point) (pos-eol))))))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) @@ -401,7 +401,7 @@ Each element has the format: (goto-char (point-min)) (should (string-match "\\`2 matches for \"and\" in buffer: " (buffer-substring-no-properties - (point) (line-end-position))))))) + (point) (pos-eol))))))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index b4576889dcd..97f425f6f48 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -321,7 +321,7 @@ See bug#35036." ;; Stay at BOB. (forward-line -1) (save-restriction - (narrow-to-region (point) (line-end-position)) + (narrow-to-region (point) (pos-eol)) (should-not (delete-indentation)) (should (equal (simple-test--buffer-substrings) '("" . " second "))) @@ -344,27 +344,23 @@ See bug#35036." (should (equal (simple-test--buffer-substrings) '(" first " . ""))) ;; Single line. - (should-not (delete-indentation - nil (line-beginning-position) (1- (point)))) + (should-not (delete-indentation nil (pos-bol) (1- (point)))) (should (equal (simple-test--buffer-substrings) '("" . " first "))) - (should-not (delete-indentation nil (1+ (point)) (line-end-position))) + (should-not (delete-indentation nil (1+ (point)) (pos-eol))) (should (equal (simple-test--buffer-substrings) '(" " . "first "))) - (should-not (delete-indentation - nil (line-beginning-position) (line-end-position))) + (should-not (delete-indentation nil (pos-bol) (pos-eol))) (should (equal (simple-test--buffer-substrings) '("" . " first "))) ;; Multiple lines. (goto-char (point-max)) (insert "\n second \n third \n fourth ") (goto-char (point-min)) - (should-not (delete-indentation - nil (line-end-position) (line-beginning-position 2))) + (should-not (delete-indentation nil (pos-eol) (pos-bol 2))) (should (equal (simple-test--buffer-substrings) '(" first" . " second \n third \n fourth "))) - (should-not (delete-indentation - nil (point) (1+ (line-beginning-position 2)))) + (should-not (delete-indentation nil (point) (1+ (pos-bol 2)))) (should (equal (simple-test--buffer-substrings) '(" first second" . " third \n fourth "))) ;; Prefix argument overrides region. @@ -808,7 +804,7 @@ See Bug#21722." (insert "a\nb\nc\nd\n") (goto-char (point-min)) (forward-line (1- target-line)) - (narrow-to-region (line-beginning-position) (line-end-position)) + (narrow-to-region (pos-bol) (pos-eol)) (should (equal (line-number-at-pos) 1)) (should (equal (line-number-at-pos nil t) target-line))))) @@ -817,7 +813,7 @@ See Bug#21722." (insert "a\nb\nc\nd\n") (goto-char (point-min)) (forward-line 2) - (narrow-to-region (line-beginning-position) (line-end-position)) + (narrow-to-region (pos-bol) (pos-eol)) (should (equal (line-number-at-pos) 1)) (line-number-at-pos nil t) (should (equal (line-number-at-pos) 1)))) diff --git a/test/lisp/textmodes/conf-mode-tests.el b/test/lisp/textmodes/conf-mode-tests.el index 2b4fde40c34..097b25f1144 100644 --- a/test/lisp/textmodes/conf-mode-tests.el +++ b/test/lisp/textmodes/conf-mode-tests.el @@ -74,8 +74,7 @@ PersistMoniker=file://Folder.htt") (ert-deftest conf-test-javaprop-mode () (with-temp-buffer ;; From `conf-javaprop-mode' docstring - (insert "// another kind of comment -/* yet another */ + (insert "# comment name:value name=value @@ -90,8 +89,6 @@ x.2.y.1.z.2.zz =") (should (equal (face-at-point) 'font-lock-comment-delimiter-face)) (forward-char 3) (should (equal (face-at-point) 'font-lock-comment-face)) - (search-forward "*") - (should (equal (face-at-point) 'font-lock-comment-delimiter-face)) (while (search-forward "nam" nil t) (should (equal (face-at-point) 'font-lock-variable-name-face)) (search-forward "val") diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index a746edf8944..1d2d556992b 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el @@ -435,7 +435,7 @@ 'css-selector) (should-not (format "Didn't recognize %s as a selector" (buffer-substring-no-properties - (point) (line-end-position))))))) + (point) (pos-eol))))))) ;; Test many selectors. (dolist (selector selectors) (with-temp-buffer @@ -451,7 +451,7 @@ 'css-selector) (should-not (format "Didn't recognize %s as a selector" (buffer-substring-no-properties - (point) (line-end-position))))))) + (point) (pos-eol))))))) ;; Test wrong separators. (dolist (selector selectors) (with-temp-buffer @@ -467,7 +467,7 @@ 'css-selector) (should-not (format "Recognized %s as a selector" (buffer-substring-no-properties - (point) (line-end-position)))))))))) + (point) (pos-eol)))))))))) (ert-deftest scss-mode-test-selectors () (let ((selectors @@ -485,7 +485,7 @@ 'css-selector) (should-not (format "Didn't recognize %s as a selector" (buffer-substring-no-properties - (point) (line-end-position)))))))))) + (point) (pos-eol)))))))))) (provide 'css-mode-tests) diff --git a/test/lisp/textmodes/fill-tests.el b/test/lisp/textmodes/fill-tests.el index b730de5a690..f2a0daf8122 100644 --- a/test/lisp/textmodes/fill-tests.el +++ b/test/lisp/textmodes/fill-tests.el @@ -53,8 +53,8 @@ (goto-char (point-min)) (search-forward "b") (let* ((pos (point)) - (beg (line-beginning-position)) - (end (line-end-position)) + (beg (pos-bol)) + (end (pos-eol)) (fill-prefix (make-string (- pos beg) ?\s)) ;; `fill-column' is too small to accommodate the current line (fill-column (- end beg 10))) @@ -68,8 +68,8 @@ (goto-char (point-min)) (search-forward "b") (let* ((pos (point)) - (beg (line-beginning-position)) - (end (line-end-position)) + (beg (pos-bol)) + (end (pos-eol)) (fill-prefix (make-string (- pos beg) ?\s)) ;; `fill-column' is too small to accommodate the current line (fill-column (- end beg 10))) diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index 8361d58b558..55e37b71d80 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -147,13 +147,11 @@ (string-to-number line-limit1)))) (goto-char (point-min)) (if (> limit-number 0) - (should (= search-limit (line-beginning-position - (1+ limit-number)))) + (should (= search-limit (pos-bol (1+ limit-number)))) (should (= search-limit (point-max)))) (goto-char (point-max)) (if (< limit-number 0) - (should (= start (line-beginning-position - (1+ limit-number)))) + (should (= start (pos-bol (1+ limit-number)))) (should (= start (point-min))))) (if (equal start1 "") (should (equal ts-start time-stamp-start)) diff --git a/test/lisp/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el index 9318e8ef590..379ad7bf039 100644 --- a/test/lisp/xt-mouse-tests.el +++ b/test/lisp/xt-mouse-tests.el @@ -28,28 +28,34 @@ (defmacro with-xterm-mouse-mode (&rest body) "Run BODY with `xterm-mouse-mode' temporarily enabled." (declare (indent 0)) - ;; Make the frame huge so that the test input events below don't hit - ;; the menu bar. - `(cl-letf (((frame-width nil) 2000) - ((frame-height nil) 2000) - ;; Reset XTerm parameters so that the tests don't get - ;; confused. - ((terminal-parameter nil 'xterm-mouse-x) nil) - ((terminal-parameter nil 'xterm-mouse-y) nil) - ((terminal-parameter nil 'xterm-mouse-last-down) nil) - ((terminal-parameter nil 'xterm-mouse-last-click) nil)) - (if xterm-mouse-mode - (progn ,@body) - (unwind-protect - (progn - ;; `xterm-mouse-mode' doesn't work in the initial - ;; terminal. Since we can't create a second terminal in - ;; batch mode, fake it temporarily. - (cl-letf (((symbol-function 'terminal-name) - (lambda (&optional _terminal) "fake-terminal"))) - (xterm-mouse-mode)) - ,@body) - (xterm-mouse-mode 0))))) + `(let ((width (frame-width)) + (height (frame-height))) + (unwind-protect + (progn + ;; Make the frame huge so that the test input events below + ;; don't hit the menu bar. + (set-frame-width nil (max width 2000)) + (set-frame-height nil (max height 2000)) + (cl-letf (;; Reset XTerm parameters so that the tests don't + ;; get confused. + ((terminal-parameter nil 'xterm-mouse-x) nil) + ((terminal-parameter nil 'xterm-mouse-y) nil) + ((terminal-parameter nil 'xterm-mouse-last-down) nil) + ((terminal-parameter nil 'xterm-mouse-last-click) nil)) + (if xterm-mouse-mode + ,(macroexp-progn body) + (unwind-protect + (progn + ;; `xterm-mouse-mode' doesn't work in the initial + ;; terminal. Since we can't create a second + ;; terminal in batch mode, fake it temporarily. + (cl-letf (((symbol-function 'terminal-name) + (lambda (&optional _terminal) "fake-terminal"))) + (xterm-mouse-mode)) + ,@body) + (xterm-mouse-mode 0))))) + (set-frame-width nil width) + (set-frame-height nil height)))) (ert-deftest xt-mouse-tracking-basic () (should (equal (xterm-mouse-tracking-enable-sequence) diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 2f25de4cc39..57143dd81e5 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -128,7 +128,7 @@ (save-excursion (goto-char (point-max)) (skip-chars-backward "\n") - (buffer-substring (line-beginning-position) (point))))) + (buffer-substring (pos-bol) (point))))) (ert-deftest lread-tests--unescaped-char-literals () "Check that loading warns about unescaped character diff --git a/test/src/process-tests.el b/test/src/process-tests.el index db8a5044783..6e1e148332c 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -160,8 +160,7 @@ process to complete." (setq count (1+ count)))))))) (set-process-query-on-exit-flag proc nil) (send-string proc "one\n") - (while (not (equal (buffer-substring - (line-beginning-position) (point-max)) + (while (not (equal (buffer-substring (pos-bol) (point-max)) "1> ")) (accept-process-output proc)) ; Read "one". (should (equal (buffer-string) "0> one\n1> ")) @@ -171,8 +170,7 @@ process to complete." (accept-process-output proc 1)) ; Can't read "two" yet. (should (equal (buffer-string) "0> one\n1> ")) (set-process-filter proc nil) ; Resume reading from proc. - (while (not (equal (buffer-substring - (line-beginning-position) (point-max)) + (while (not (equal (buffer-substring (pos-bol) (point-max)) "2> ")) (accept-process-output proc)) ; Read "Two". (should (equal (buffer-string) "0> one\n1> two\n2> ")))))) diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el index c84ed74f0b1..cb0822fb1b9 100644 --- a/test/src/undo-tests.el +++ b/test/src/undo-tests.el @@ -460,11 +460,10 @@ Demonstrates bug 25599." (delete-overlay ov)))))) (save-excursion (goto-char (point-min)) - (let ((ov (make-overlay (line-beginning-position 2) - (line-end-position 2)))) + (let ((ov (make-overlay (pos-bol 2) (pos-eol 2)))) (overlay-put ov 'insert-in-front-hooks (list overlay-modified))))) - (kill-region (point-min) (line-beginning-position 2)) + (kill-region (point-min) (pos-bol 2)) (undo-boundary) (undo))) |