diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index f4e08d59dd0..bab2573c883 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -91,7 +91,7 @@ test-filenotify-gio:
- ./autogen.sh autoconf
- ./configure --without-makeinfo --with-file-notification=gfile
- make bootstrap
- - make -C test autorevert-tests filenotify-tests
+ - make -k -C test autorevert-tests filenotify-tests
test-gnustep:
stage: test
diff --git a/admin/nt/dist-build/build-dep-zips.py b/admin/nt/dist-build/build-dep-zips.py
index 7047d28346d..bc5f65f0853 100755
--- a/admin/nt/dist-build/build-dep-zips.py
+++ b/admin/nt/dist-build/build-dep-zips.py
@@ -18,7 +18,6 @@
## along with GNU Emacs. If not, see .
import argparse
import multiprocessing as mp
-import glob
import os
import shutil
import re
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 1f10b68b8a7..aa4513e3175 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -2199,12 +2199,22 @@ Display the reference on the current line.
Move to the next reference and display it in the other window
(@code{xref-next-line}).
+@item N
+@findex xref-next-group
+Move to the first reference of the next reference group and display it
+in the other window (@code{xref-next-group}).
+
@item p
@itemx ,
@findex xref-prev-line
Move to the previous reference and display it in the other window
(@code{xref-prev-line}).
+@item P
+@findex xref-prev-group
+Move to the first reference of the previous reference group and
+display it in the other window (@code{xref-prev-group}).
+
@item C-o
@findex xref-show-location-at-point
Display the reference on the current line in the other window
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 5b5134b7c3f..c2c382ead0b 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -1893,6 +1893,12 @@ with @kbd{C-x #}. But @kbd{C-x #} is the way to tell
window or a frame, @kbd{C-x #} always displays the next server buffer
in that window or in that frame.
+@vindex server-client-instructions
+ When @command{emacsclient} connects, the server will normally output
+a message that says how to exit the client frame. If
+@code{server-client-instructions} is set to @code{nil}, this message
+is inhibited.
+
@node emacsclient Options
@subsection @code{emacsclient} Options
@cindex @code{emacsclient} options
@@ -2255,13 +2261,18 @@ off.
@vindex ps-print-color-p
If your printer doesn't support colors, you should turn off color
processing by setting @code{ps-print-color-p} to @code{nil}. By
-default, if the display supports colors, Emacs produces hardcopy output
-with color information; on black-and-white printers, colors are emulated
-with shades of gray. This might produce illegible output, even if your
-screen colors only use shades of gray.
+default, if the display supports colors, Emacs produces hardcopy
+output with color information; on black-and-white printers, colors are
+emulated with shades of gray. This might produce barely-readable or
+even illegible output, even if your screen colors only use shades of
+gray.
- Alternatively, you can set @code{ps-print-color-p} to @code{black-white} to
-print colors on black/white printers.
+@vindex ps-black-white-faces
+ Alternatively, you can set @code{ps-print-color-p} to @code{black-white}
+to have colors display better on black/white printers. This works by
+using information in @code{ps-black-white-faces} to express colors by
+customizable list of shades of gray, augmented by bold and italic
+face attributes.
@vindex ps-use-face-background
By default, PostScript printing ignores the background colors of the
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index 14ee062b6cf..467c5269866 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -1273,9 +1273,9 @@ temporary buffer to display the current @acronym{MIME} message.
@findex rmail-epa-decrypt
@cindex encrypted mails (reading in Rmail)
- If the current message is an encrypted one, use the command @kbd{M-x
-rmail-epa-decrypt} to decrypt it, using the EasyPG library
-(@pxref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}).
+ If the current message is an encrypted one, use the command
+@kbd{C-c C-d} (@code{rmail-epa-decrypt}) to decrypt it, using the
+EasyPG library (@pxref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}).
You can highlight and activate URLs in the Rmail buffer using Goto
Address mode:
diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi
index 379279575ca..c20ef6830ad 100644
--- a/doc/lispref/backups.texi
+++ b/doc/lispref/backups.texi
@@ -706,7 +706,11 @@ contents and the file contents are identical before the revert
operation, reverting preserves all the markers. If they are not
identical, reverting does change the buffer; in that case, it preserves
the markers in the unchanged text (if any) at the beginning and end of
-the buffer. Preserving any additional markers would be problematical.
+the buffer. Preserving any additional markers would be problematic.
+
+When reverting from non-file sources, markers are usually not
+preserved, but this is up to the specific @code{revert-buffer-function}
+implementation.
@end deffn
@defvar revert-buffer-in-progress-p
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index f86baf59360..2b3119ea590 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -2632,10 +2632,12 @@ appearance of @var{face} will again be determined by its default face
spec.
@cindex @code{eval-defun}, and @code{defface} forms
+@cindex @code{eval-last-sexp}, and @code{defface} forms
As an exception, if you evaluate a @code{defface} form with
-@kbd{C-M-x} in Emacs Lisp mode (@code{eval-defun}), a special feature
-of @code{eval-defun} overrides any custom face specs on the face,
-causing the face to reflect exactly what the @code{defface} says.
+@kbd{C-M-x} (@code{eval-defun}) or with @kbd{C-x C-e}
+(@code{eval-last-sexp}) in Emacs Lisp mode, a special feature of these
+commands overrides any custom face specs on the face, causing the face
+to reflect exactly what the @code{defface} says.
The @var{spec} argument is a @dfn{face spec}, which states how the
face should appear on different kinds of terminals. It should be an
@@ -5898,6 +5900,26 @@ string containing the image data as raw bytes. @var{image-type} should be a
@end lisp
@end defun
+@defun svg-embed-base-uri-image svg relative-filename &rest args
+To @var{svg} add an embedded (raster) image placed at
+@var{relative-filename}. @var{relative-filename} is searched inside
+@code{file-name-directory} of the @code{:base-uri} svg image property.
+This improves the performance of embedding large images.
+
+@lisp
+;; Embeding /tmp/subdir/rms.jpg and /tmp/another/rms.jpg
+(svg-embed-base-uri-image svg "subdir/rms.jpg"
+ :width "100px" :height "100px"
+ :x "50px" :y "75px")
+(svg-embed-base-uri-image svg "another/rms.jpg"
+ :width "100px" :height "100px"
+ :x "75px" :y "50px")
+(svg-image svg :scale 1.0
+ :base-uri "/tmp/dummy"
+ :width 175 :height 175)
+@end lisp
+@end defun
+
@defun svg-clip-path svg &rest args
Add a clipping path to @var{svg}. If applied to a shape via the
@var{:clip-path} property, parts of that shape which lie outside of
@@ -6575,6 +6597,12 @@ except when you explicitly clear it. This mode can be useful for
debugging.
@end defvar
+@defun image-cache-size
+This function returns the total size of the current image cache, in
+bytes. An image of size 200x100 with 24 bits per color will have a
+cache size of 60000 bytes, for instance.
+@end defun
+
@node Xwidgets
@section Embedded Native Widgets
@cindex xwidget
@@ -6879,6 +6907,16 @@ This inserts a button with the label @var{label} at point, using text
properties.
@end defun
+@defun button-buttonize string callback &optional data
+Sometimes it's more convenient to make a string into a button without
+inserting it into a buffer immediately, for instance when creating
+data structures that may then, later, be inserted into a buffer. This
+function makes @var{string} into such a string, and @var{callback}
+will be called when the user clicks on the button. The optional
+@var{data} parameter will be used as the parameter when @var{callback}
+is called. If @code{nil}, the button is used as the parameter instead.
+@end defun
+
@node Manipulating Buttons
@subsection Manipulating Buttons
@cindex manipulating buttons
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index bb25983aa4b..28a5fdb3492 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -615,6 +615,19 @@ during garbage collection so far in this Emacs session, as a
floating-point number.
@end defvar
+@defun memory-report
+It can sometimes be useful to see where Emacs is using memory (in
+various variables, buffers, and caches). This command will open a new
+buffer (called @samp{"*Memory Report*"}) that will give an overview,
+in addition to listing the ``largest'' buffers and variables.
+
+All the data here is approximate, because there's really no consistent
+way to compute the size of a variable. For instance, two variables
+may share parts of a data structure, and this will be counted twice,
+but this command may still give a useful high-level overview of which
+parts of Emacs is using memory.
+@end defun
+
@node Stack-allocated Objects
@section Stack-allocated Objects
@@ -1851,7 +1864,10 @@ byte, is @var{len}. The original string in @var{str} can be either an
it can include embedded null bytes, and doesn't have to end in a
terminating null byte at @code{@var{str}[@var{len}]}. The function
raises the @code{overflow-error} error condition if @var{len} is
-negative or exceeds the maximum length of an Emacs string.
+negative or exceeds the maximum length of an Emacs string. If
+@var{len} is zero, then @var{str} can be @code{NULL}, otherwise it
+must point to valid memory. For nonzero @var{len}, @code{make_string}
+returns unique mutable string objects.
@end deftypefn
@deftypefn Function emacs_value make_unibyte_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{len})
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 130ff0d8671..6635f50960a 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -2167,9 +2167,10 @@ string. Thus, the string need not be a constant.
The third element, @var{real-binding}, can be the command to execute
(in which case you get a normal menu item). It can also be a keymap,
-which will result in a submenu. Finally, it can be @code{nil}, in
-which case you will get a non-selectable menu item. This is mostly
-useful when creating separator lines and the like.
+which will result in a submenu, and @var{item-name} is used as the
+submenu name. Finally, it can be @code{nil}, in which case you will
+get a non-selectable menu item. This is mostly useful when creating
+separator lines and the like.
The tail of the list, @var{item-property-list}, has the form of a
property list which contains other information.
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index f897cfa4eab..bc602205f5d 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -2633,14 +2633,14 @@ calls @var{function} with no arguments, or @samp{--eval=@var{form}}.
Any Lisp program output that would normally go to the echo area,
either using @code{message}, or using @code{prin1}, etc., with
-@code{t} as the stream, goes instead to Emacs's standard descriptors
-when in batch mode: @code{message} writes to the standard error
-descriptor, while @code{prin1} and other print functions write to the
-standard output. Similarly, input that would normally come from the
-minibuffer is read from the standard input descriptor. Thus, Emacs
-behaves much like a noninteractive application program. (The echo
-area output that Emacs itself normally generates, such as command
-echoing, is suppressed entirely.)
+@code{t} as the stream (@pxref{Output Streams}), goes instead to
+Emacs's standard descriptors when in batch mode: @code{message} writes
+to the standard error descriptor, while @code{prin1} and other print
+functions write to the standard output. Similarly, input that would
+normally come from the minibuffer is read from the standard input
+descriptor. Thus, Emacs behaves much like a noninteractive
+application program. (The echo area output that Emacs itself normally
+generates, such as command echoing, is suppressed entirely.)
Non-ASCII text written to the standard output or error descriptors is
by default encoded using @code{locale-coding-system} (@pxref{Locales})
diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi
index 0534afb67fa..5b4be832507 100644
--- a/doc/lispref/streams.texi
+++ b/doc/lispref/streams.texi
@@ -123,13 +123,13 @@ came from. In this case, it makes no difference what value
@code{t} used as a stream means that the input is read from the
minibuffer. In fact, the minibuffer is invoked once and the text
given by the user is made into a string that is then used as the
-input stream. If Emacs is running in batch mode, standard input is used
-instead of the minibuffer. For example,
+input stream. If Emacs is running in batch mode (@pxref{Batch Mode}),
+standard input is used instead of the minibuffer. For example,
@example
(message "%s" (read t))
@end example
-will read a Lisp expression from standard input and print the result
-to standard output.
+will in batch mode read a Lisp expression from standard input and
+print the result to standard output.
@item @code{nil}
@cindex @code{nil} input stream
@@ -392,13 +392,15 @@ is responsible for storing the characters wherever you want to put them.
@item @code{t}
@cindex @code{t} output stream
-The output characters are displayed in the echo area.
+The output characters are displayed in the echo area. If Emacs is
+running in batch mode (@pxref{Batch Mode}), the output is written to
+the standard output descriptor instead.
@item @code{nil}
@cindex @code{nil} output stream
-@code{nil} specified as an output stream means to use the value of
-@code{standard-output} instead; that value is the @dfn{default output
-stream}, and must not be @code{nil}.
+@code{nil} specified as an output stream means to use the value of the
+@code{standard-output} variable instead; that value is the
+@dfn{default output stream}, and must not be @code{nil}.
@item @var{symbol}
A symbol as output stream is equivalent to the symbol's function
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index c6ca4eed2e1..b712768a213 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -2931,6 +2931,22 @@ used instead. Here is an example:
@end example
@end defvar
+@defun object-intervals OBJECT
+This function returns a copy of the intervals (i.e., text properties)
+in @var{object} as a list of intervals. @var{object} must be a string
+or a buffer. Altering the structure of this list does not change the
+intervals in the object.
+
+@example
+(object-intervals (propertize "foo" 'face 'bold))
+ @result{} ((0 3 (face bold)))
+@end example
+
+Each element in the returned list represents one interval. Each
+interval has three parts: The first is the start, the second is the
+end, and the third part is the text property itself.
+@end defun
+
@node Changing Properties
@subsection Changing Text Properties
@cindex changing text properties
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 095ea9dce24..b9ff0747382 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -481,10 +481,12 @@ form occurs in a @code{let} form with lexical binding enabled), then
effect until its binding construct exits. @xref{Variable Scoping}.
@cindex @code{eval-defun}, and @code{defvar} forms
-When you evaluate a top-level @code{defvar} form with @kbd{C-M-x} in
-Emacs Lisp mode (@code{eval-defun}), a special feature of
-@code{eval-defun} arranges to set the variable unconditionally, without
-testing whether its value is void.
+@cindex @code{eval-last-sexp}, and @code{defvar} forms
+When you evaluate a top-level @code{defvar} form with @kbd{C-M-x}
+(@code{eval-defun}) or with @kbd{C-x C-e} (@code{eval-last-sexp}) in
+Emacs Lisp mode, a special feature of these two commands arranges to
+set the variable unconditionally, without testing whether its value is
+void.
If the @var{doc-string} argument is supplied, it specifies the
documentation string for the variable (stored in the symbol's
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 6a6f585ce20..1fa13e98b3c 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -28047,13 +28047,7 @@ defined as the distance that light will travel in a vacuum in
vacuum is exactly 299792458 m/s. Many other units have been
redefined in terms of fundamental physical processes; a second, for
example, is currently defined as 9192631770 periods of a certain
-radiation related to the cesium-133 atom. The only SI unit that is not
-based on a fundamental physical process (although there are efforts to
-change this) is the kilogram, which was originally defined as the mass
-of one liter of water, but is now defined as the mass of the
-international prototype of the kilogram (IPK), a cylinder of platinum-iridium
-kept at the Bureau international des poids et mesures in Sèvres,
-France. (There are several copies of the IPK throughout the world.)
+radiation related to the cesium-133 atom.
The British imperial units, once defined in terms of physical objects,
were redefined in 1963 in terms of SI units. The US customary units,
which were the same as British units until the British imperial system
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 084edd11b2d..742be28fe34 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -1097,10 +1097,9 @@ by @var{x} if specified.
@defmac cl-pushnew x place @t{&key :test :test-not :key}
This macro inserts @var{x} at the front of the list stored in
-@var{place}, but only if @var{x} was not @code{eql} to any
-existing element of the list. The optional keyword arguments
-are interpreted in the same way as for @code{cl-adjoin}.
-@xref{Lists as Sets}.
+@var{place}, but only if @var{x} isn't present in the list already.
+The optional keyword arguments are interpreted in the same way as for
+@code{cl-adjoin}. @xref{Lists as Sets}.
@end defmac
@defmac cl-shiftf place@dots{} newvalue
@@ -3796,8 +3795,10 @@ This is a destructive version of @code{cl-sublis}.
@section Lists as Sets
@noindent
-These functions perform operations on lists that represent sets
-of elements.
+These functions perform operations on lists that represent sets of
+elements. All these functions (unless otherwise specified) default to
+using @code{eql} as the test function, but that can be modified by the
+@code{:test} parameter.
@defun cl-member item list @t{&key :test :test-not :key}
This function searches @var{list} for an element matching @var{item}.
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 1bc9d41f9bb..462eb4cf3ae 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -512,10 +512,10 @@ This chapter tells you how to get help with Emacs.
@cindex Help system, entering the
Type @kbd{C-h t} to invoke the self-paced tutorial. Just typing
-@kbd{C-h} enters the help system. Starting with Emacs 22, the tutorial
-is available in many foreign languages such as French, German, Japanese,
-Russian, etc. Use @kbd{M-x help-with-tutorial-spec-language @key{RET}}
-to choose your language and start the tutorial.
+@kbd{C-h} enters the help system. The tutorial is available in many
+foreign languages such as French, German, Japanese, Russian, etc. Use
+@kbd{M-x help-with-tutorial-spec-language @key{RET}} to choose your
+language and start the tutorial.
Your system administrator may have changed @kbd{C-h} to act like
@key{DEL} to deal with local keyboards. You can use @kbd{M-x
@@ -966,9 +966,9 @@ latest features, you may want to stick to the releases.
The following sections list some of the major new features in the last
few Emacs releases. For full details of the changes in any version of
-Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). As of Emacs 22,
-you can give this command a prefix argument to read about which features
-were new in older versions.
+Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). You can give
+this command a prefix argument to read about which features were new
+in older versions.
@node New in Emacs 26
@section What is different about Emacs 26?
@@ -1725,14 +1725,6 @@ buffer by default, put this in your @file{.emacs} file:
(setq abbrev-mode t)))
@end lisp
-@noindent If your Emacs version is older then 22.1, you will also need to use:
-
-@lisp
-(condition-case ()
- (quietly-read-abbrev-file)
- (file-error nil))
-@end lisp
-
@node Associating modes with files
@section How do I make Emacs use a certain major mode for certain files?
@cindex Associating modes with files
@@ -2583,16 +2575,14 @@ effective way of doing that. Emacs automatically intercepts the compile
error messages, inserts them into a special buffer called
@file{*compilation*}, and lets you visit the locus of each message in
the source. Type @kbd{C-x `} to step through the offending lines one by
-one (starting with Emacs 22, you can also use @kbd{M-g M-p} and
-@kbd{M-g M-n} to go to the previous and next matches directly). Click
-@kbd{mouse-2} or press @key{RET} on a message text in the
-@file{*compilation*} buffer to go to the line whose number is mentioned
-in that message.
+one (you can also use @kbd{M-g M-p} and @kbd{M-g M-n} to go to the
+previous and next matches directly). Click @kbd{mouse-2} or press
+@key{RET} on a message text in the @file{*compilation*} buffer to go
+to the line whose number is mentioned in that message.
But if you indeed need to go to a certain text line, type @kbd{M-g M-g}
-(which is the default binding of the @code{goto-line} function starting
-with Emacs 22). Emacs will prompt you for the number of the line and go
-to that line.
+(which is the default binding of the @code{goto-line} function).
+Emacs will prompt you for the number of the line and go to that line.
You can do this faster by invoking @code{goto-line} with a numeric
argument that is the line's number. For example, @kbd{C-u 286 M-g M-g}
@@ -2825,13 +2815,13 @@ Add the following line to your @file{.emacs} file:
@cindex @code{ls} in Shell mode
In many systems, @code{ls} is aliased to @samp{ls --color}, which
-prints using ANSI color escape sequences. Emacs version 21.1 and
-later includes the @code{ansi-color} package, which lets Shell mode
-recognize these escape sequences. In Emacs 23.2 and later, the
-package is enabled by default; in earlier versions you can enable it
-by typing @kbd{M-x ansi-color-for-comint-mode} in the Shell buffer, or
-by adding @code{(add-hook 'shell-mode-hook
-'ansi-color-for-comint-mode-on)} to your init file.
+prints using ANSI color escape sequences. Emacs includes the
+@code{ansi-color} package, which lets Shell mode recognize these
+escape sequences. In Emacs 23.2 and later, the package is enabled by
+default; in earlier versions you can enable it by typing @kbd{M-x
+ansi-color-for-comint-mode} in the Shell buffer, or by adding
+@code{(add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)} to
+your init file.
@node Fullscreen mode on MS-Windows
@section How can I start Emacs in fullscreen mode on MS-Windows?
@@ -3210,12 +3200,11 @@ arbitrary Emacs Lisp code evaluated when the file is visited.
Obviously, there is a potential for Trojan horses to exploit this
feature.
-As of Emacs 22, Emacs has a list of local variables that are known to
-be safe to set. If a file tries to set any variable outside this
-list, it asks the user to confirm whether the variables should be set.
-You can also tell Emacs whether to allow the evaluation of Emacs Lisp
-code found at the bottom of files by setting the variable
-@code{enable-local-eval}.
+Emacs has a list of local variables that are known to be safe to set.
+If a file tries to set any variable outside this list, it asks the
+user to confirm whether the variables should be set. You can also tell
+Emacs whether to allow the evaluation of Emacs Lisp code found at the
+bottom of files by setting the variable @code{enable-local-eval}.
@xref{File Variables,,, emacs, The GNU Emacs Manual}.
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 4aa07ce3887..3743b497da8 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -5028,10 +5028,37 @@ Nothing if the article is a root and lots of spaces if it isn't (it
pushes everything after it off the screen).
@item [
Opening bracket, which is normally @samp{[}, but can also be @samp{<}
-for adopted articles (@pxref{Customizing Threading}).
+for adopted articles (@pxref{Customizing Threading}). This can be
+customized using following settings:
+
+@table @code
+@item gnus-sum-opening-bracket
+@vindex gnus-sum-opening-bracket
+Opening bracket for normal (non-adopted) articles. The default is
+@samp{[}.
+
+@item gnus-sum-opening-bracket-adopted
+@vindex gnus-sum-opening-bracket-adopted
+Opening bracket for adopted articles. The default is @samp{<}.
+
+@end table
+
@item ]
Closing bracket, which is normally @samp{]}, but can also be @samp{>}
-for adopted articles.
+for adopted articles. This can be customised using following settings:
+
+@table @code
+@item gnus-sum-closing-bracket
+@vindex gnus-sum-closing-bracket
+Closing bracket for normal (non-adopted) articles. The default is
+@samp{]}.
+
+@item gnus-sum-closing-bracket-adopted
+@vindex gnus-sum-opening-bracket-adopted
+Closing bracket for adopted articles. The default is @samp{>}.
+
+@end table
+
@item >
One space for each thread level.
@item <
@@ -26260,6 +26287,16 @@ registry will keep. If the registry has reached or exceeded this
size, it will reject insertion of new entries.
@end defvar
+@defvar gnus-registry-register-all
+If this option is non-nil, the registry will register all messages, as
+you see them. This is important to making split-to-parent and
+Message-ID references work correctly, as the registry needs to know
+where all messages are, but it can slow down group opening and the
+saving of Gnus. If this option is nil, entries must be created
+manually, for instance by storing a custom flag or keyword for the
+message.
+@end defvar
+
@defvar gnus-registry-prune-factor
This option (a float between 0 and 1) controls how much the registry
is cut back during pruning. In order to prevent constant pruning, the
@@ -26349,8 +26386,14 @@ have to put a rule like this:
"mail")
@end lisp
-in your fancy split setup. In addition, you may want to customize the
-following variables.
+in your fancy split setup.
+
+If @code{gnus-registry-register-all} is non-nil (the default), the
+registry will perform splitting for all messages. If it is nil,
+splitting will only happen for children of messages you've explicitly
+registered.
+
+In addition, you may want to customize the following variables.
@defvar gnus-registry-track-extra
This is a list of symbols, so it's best to change it from the
@@ -26423,7 +26466,9 @@ Store @code{value} under @code{key} for message @code{id}.
@end defun
@defun gnus-registry-get-id-key (id key)
-Get the data under @code{key} for message @code{id}.
+Get the data under @code{key} for message @code{id}. If the option
+@code{gnus-registry-register-all} is non-nil, this function will also
+create an entry for @code{id} if one doesn't exist.
@end defun
@defvar gnus-registry-extra-entries-precious
diff --git a/etc/NEWS b/etc/NEWS
index 525ed8b36ee..909473f4e77 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -88,6 +88,13 @@ useful on systems such as FreeBSD which ships only with "etc/termcap".
** Minibuffer scrolling is now conservative by default.
This is controlled by the new variable 'scroll-minibuffer-conservatively'.
+In addition, there is a new variable
+`redisplay-adhoc-scroll-in-resize-mini-windows` to disable the
+ad-hoc auto-scrolling when resizing minibuffer windows. It has been
+found that its heuristic can be counter productive in some corner
+cases, tho the cure may be worse than the disease. This said, the
+effect should be negligible in the vast majority of cases anyway.
+
+++
** Improved handling of minibuffers on switching frames.
By default, when you switch to another frame, an active minibuffer now
@@ -192,6 +199,11 @@ have been replaced with "chat.freenode.net" throughout Emacs.
These functions return the connection local value of the respective
variables. This can be used for remote hosts.
+** Emacs now prints a backtrace when signaling an error in batch mode.
+This makes debugging Emacs Lisp scripts run in batch mode easier. To
+get back the old behavior, set the new variable
+'backtrace-on-error-noninteractive' to a nil value.
+
* Editing Changes in Emacs 28.1
@@ -270,6 +282,11 @@ preserving markers, properties and overlays. The new variable
number of seconds that 'revert-buffer-with-fine-grain' should spend
trying to be non-destructive.
++++
+** New command 'memory-report'.
+This command opens a new buffer called "*Memory Report*" and gives a
+summary of where Emacs is using memory currently.
+
** Outline
+++
@@ -282,6 +299,18 @@ the buffer cycles the whole buffer between "only top-level headings",
* Changes in Specialized Modes and Packages in Emacs 28.1
+** Loading dunnet.el in batch mode doesn't start the game any more
+Instead you need to do 'emacs -f dun-batch' to start the game in
+batch mode.
+
+** Emacs Server
+
++++
+*** New user option 'server-client-instructions'.
+When emacsclient connects, Emacs will (by default) output a message
+about how to exit the client frame. If 'server-client-instructions'
+is set to nil, this message is inhibited.
+
** Python mode
*** 'C-c C-r' can now be used on arbitrary regions.
@@ -488,6 +517,26 @@ tags to be considered as well.
** Gnus
++++
+*** New user option 'gnus-registry-register-all'.
+
+If non-nil (the default), create registry entries for all messages.
+If nil, don't automatically create entries, they must be created
+manually.
+
++++
+*** New user options to customise the summary line specs %[ and %].
+Four new options introduced in customisation group
+'gnus-summary-format'. These are 'gnus-sum-opening-bracket',
+'gnus-sum-closing-bracket', 'gnus-sum-opening-bracket-adopted', and
+'gnus-sum-closing-bracket-adopted'. Their default values are '[', ']',
+'<', '>' respectively. These variables control the appearance of '%['
+and '%]' specs in the summary line format. '%[' will normally display
+the value of 'gnus-sum-opening-bracket', but can also be
+'gnus-sum-opening-bracket-adopted' for the adopted articles. '%]' will
+normally display the value of 'gnus-sum-closing-bracket', but can also
+be 'gnus-sum-closing-bracket-adopted' for the adopted articles.
+
+++
*** New user option 'gnus-paging-select-next'.
This controls what happens when using commands like 'SPC' and 'DEL' to
@@ -1076,6 +1125,22 @@ If 'shr-width' is non-nil, it overrides this variable.
** Images
+---
+** Can explicitly specify base_uri for svg images.
+':base-uri' image property can be used to explicitly specify base_uri
+for embedded images into svg. ':base-uri' is supported for both file
+and data svg images.
+
++++
+** 'svg-embed-base-uri-image' added to embed images
+'svg-embed-base-uri-image' can be used to embed images located
+relatively to 'file-name-directory' of the ':base-uri' svg image property.
+This works much faster then 'svg-embed'.
+
++++
+*** New function 'image-cache-size'.
+This function returns the size of the current image cache, in bytes.
+
---
*** Animated images stop automatically under high CPU pressure sooner.
Previously, an animated image would stop animating if any single image
@@ -1192,6 +1257,11 @@ So far Grep and ripgrep are supported. ripgrep seems to offer better
performance in certain cases, in particular for case-insensitive
searches.
++++
+*** New commands 'xref-prev-group' and 'xref-next-group'.
+These commands are bound respectively to 'P' and 'N', and navigate to
+the first item of the previous or next group in the "*xref*" buffer.
+
** json.el
---
@@ -1350,8 +1420,41 @@ This face is used for error messages from 'diff'.
*** New command 'diff-refresh-hunk'.
This new command (bound to 'C-c C-l') regenerates the current hunk.
+** Buttons
+
++++
+*** New minor mode 'button-mode'.
+This minor mode does nothing else than install 'button-buffer-map' as
+a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate
+to buttons), and can be used in any view-mode-like buffer that has
+buttons in it.
+
++++
+*** New utility function 'button-buttonize'.
+This function takes a string and returns a string propertized in a way
+that makes it a valid button.
+
+
** Miscellaneous
++++
+*** New function 'object-intervals'.
+This function returns a copy of the list of intervals (i.e., text
+properties) in the object in question (which must either be a string
+or a buffer).
+
+---
+*** 'hexl-mode' scrolling commands now heed 'next-screen-context-lines'.
+Previously, 'hexl-scroll-down' and 'hexl-scroll-up' would scroll
+up/down an entire window, but they now work more like the standard
+scrolling commands.
+
+---
+*** Errors in 'kill-emacs-hook' no longer prevent Emacs from shutting down.
+If a function in that hook signals an error in an interactive Emacs,
+the user will be prompted on whether to continue. If the user doesn't
+answer within five seconds, Emacs will continue shutting down anyway.
+
---
*** iso-transl is now preloaded.
This means that keystrokes like 'Alt-[' are defined by default,
@@ -1450,13 +1553,6 @@ both modes are on).
This works like 'report-emacs-bug', but is more geared towards sending
patches to the Emacs issue tracker.
-+++
-*** New minor mode 'button-mode'.
-This minor mode does nothing else than install 'button-buffer-map' as
-a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate
-to buttons), and can be used in any view-mode-like buffer that has
-buttons in it.
-
---
*** 'icomplete-show-matches-on-no-input' behavior change.
Previously, choosing a different completion with commands like 'C-.'
diff --git a/etc/grep.txt b/etc/grep.txt
index 19a3b4b47b7..3dc4aac3c89 100644
--- a/etc/grep.txt
+++ b/etc/grep.txt
@@ -85,6 +85,12 @@ git --no-pager grep -inH -p -e "org-element-map"
lisp/org/org.el[36m=[m20969[36m=[m(defun org-fill-paragraph (&optional justify)
lisp/org/org.el[36m:[m21047[36m:[m ([1;31morg-element-map[m
+* ripgrep
+
+rg -nH --color always --no-heading -e grep-match-regexp
+[0m[35mlisp/progmodes/grep.el[0m:[0m[32m608[0m: (while (re-search-forward [0m[1m[31mgrep-match-regexp[0m end 1)
+Binary file emacs.info matches (found "\u{0}" byte around offset 2222525)
+
* unknown greps
grep -nH -e "xyzxyz" ../info/*
diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt
index bcde6728b5c..1ede2b929a0 100644
--- a/etc/publicsuffix.txt
+++ b/etc/publicsuffix.txt
@@ -1152,7 +1152,7 @@ gov.gr
// gs : https://en.wikipedia.org/wiki/.gs
gs
-// gt : http://www.gt/politicas_de_registro.html
+// gt : https://www.gt/sitio/registration_policy.php?lang=en
gt
com.gt
edu.gt
@@ -4703,6 +4703,7 @@ nl
// Norid geographical second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-b/
// Norid category second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-c/
// Norid category second-level domains managed by parties other than Norid : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-d/
+// RSS feed: https://teknisk.norid.no/en/feed/
no
// Norid category second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-c/
fhs.no
@@ -7110,7 +7111,7 @@ org.zw
// newGTLDs
-// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2020-10-08T17:45:32Z
+// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2020-11-30T20:26:10Z
// This list is auto-generated, don't edit it manually.
// aaa : 2015-02-26 American Automobile Association, Inc.
aaa
@@ -7328,7 +7329,7 @@ author
// auto : 2014-11-13 XYZ.COM LLC
auto
-// autos : 2014-01-09 DERAutos, LLC
+// autos : 2014-01-09 XYZ.COM LLC
autos
// avianca : 2015-01-08 Avianca Holdings S.A.
@@ -7337,7 +7338,7 @@ avianca
// aws : 2015-06-25 Amazon Registry Services, Inc.
aws
-// axa : 2013-12-19 AXA SA
+// axa : 2013-12-19 AXA Group Operations SAS
axa
// azure : 2014-12-18 Microsoft Corporation
@@ -7478,7 +7479,7 @@ bmw
// bnpparibas : 2014-05-29 BNP Paribas
bnpparibas
-// boats : 2014-12-04 DERBoats, LLC
+// boats : 2014-12-04 XYZ.COM LLC
boats
// boehringer : 2015-07-09 Boehringer Ingelheim International GmbH
@@ -7517,7 +7518,7 @@ bot
// boutique : 2013-11-14 Binky Moon, LLC
boutique
-// box : 2015-11-12 .BOX INC.
+// box : 2015-11-12 Intercap Registry Inc.
box
// bradesco : 2014-12-18 Banco Bradesco S.A.
@@ -8501,7 +8502,7 @@ homedepot
// homegoods : 2015-07-16 The TJX Companies, Inc.
homegoods
-// homes : 2014-01-09 DERHomes, LLC
+// homes : 2014-01-09 XYZ.COM LLC
homes
// homesense : 2015-07-16 The TJX Companies, Inc.
@@ -8651,9 +8652,6 @@ java
// jcb : 2014-11-20 JCB Co., Ltd.
jcb
-// jcp : 2015-04-23 JCP Media, Inc.
-jcp
-
// jeep : 2015-07-30 FCA US LLC.
jeep
@@ -9077,7 +9075,7 @@ moscow
// moto : 2015-06-04 Motorola Trademark Holdings, LLC
moto
-// motorcycles : 2014-01-09 DERMotorcycles, LLC
+// motorcycles : 2014-01-09 XYZ.COM LLC
motorcycles
// mov : 2014-01-30 Charleston Road Registry Inc.
@@ -9242,7 +9240,7 @@ one
// ong : 2014-03-06 Public Interest Registry
ong
-// onl : 2013-09-16 I-Registry Ltd.
+// onl : 2013-09-16 iRegistry GmbH
onl
// online : 2015-01-15 DotOnline Inc.
@@ -9539,7 +9537,7 @@ reviews
// rexroth : 2015-06-18 Robert Bosch GMBH
rexroth
-// rich : 2013-11-21 I-Registry Ltd.
+// rich : 2013-11-21 iRegistry GmbH
rich
// richardli : 2015-05-14 Pacific Century Asset Management (HK) Limited
@@ -9758,9 +9756,6 @@ show
// showtime : 2015-08-06 CBS Domains Inc.
showtime
-// shriram : 2014-01-23 Shriram Capital Ltd.
-shriram
-
// silk : 2015-06-25 Amazon Registry Services, Inc.
silk
@@ -10073,7 +10068,7 @@ travelers
// travelersinsurance : 2015-03-26 Travelers TLD, LLC
travelersinsurance
-// trust : 2014-10-16 NCC Group Domain Services, Inc.
+// trust : 2014-10-16 UNR Corp.
trust
// trv : 2015-03-26 Travelers TLD, LLC
@@ -10595,7 +10590,7 @@ vermögensberatung
// xyz : 2013-12-05 XYZ.COM LLC
xyz
-// yachts : 2014-01-09 DERYachts, LLC
+// yachts : 2014-01-09 XYZ.COM LLC
yachts
// yahoo : 2015-04-02 Yahoo! Domain Services Inc.
@@ -10680,12 +10675,6 @@ barsy.ca
// Submitted by Werner Kaltofen
kasserver.com
-// Algorithmia, Inc. : algorithmia.com
-// Submitted by Eli Perelman
-*.algorithmia.com
-!teams.algorithmia.com
-!test.algorithmia.com
-
// Altervista: https://www.altervista.org
// Submitted by Carlo Cannas
altervista.org
@@ -10868,6 +10857,10 @@ bnr.la
// Submitted by Paul Crowder
blackbaudcdn.net
+// Blatech : http://www.blatech.net
+// Submitted by Luke Bratch
+of.je
+
// Boomla : https://boomla.com
// Submitted by Tibor Halter
boomla.net
@@ -10981,10 +10974,6 @@ c.la
// Submitted by B. Blechschmidt
certmgr.org
-// Citrix : https://citrix.com
-// Submitted by Alex Stoddard
-xenapponazure.com
-
// Civilized Discourse Construction Kit, Inc. : https://www.discourse.org/
// Submitted by Rishabh Nambiar & Michael Brown
discourse.group
@@ -11073,10 +11062,6 @@ cloudns.pro
cloudns.pw
cloudns.us
-// Cloudeity Inc : https://cloudeity.com
-// Submitted by Stefan Dimitrov
-cloudeity.net
-
// CNPY : https://cnpy.gdn
// Submitted by Angelo Gladding
cnpy.gdn
@@ -11537,6 +11522,10 @@ ddnss.org
definima.net
definima.io
+// DigitalOcean : https://digitalocean.com/
+// Submitted by Braxton Huggins
+ondigitalocean.app
+
// dnstrace.pro : https://dnstrace.pro/
// Submitted by Chris Partridge
bci.dnstrace.pro
@@ -11802,6 +11791,10 @@ ukco.me
// submitted by Koen Van Isterdael
mydobiss.com
+// FH Muenster : https://www.fh-muenster.de
+// Submitted by Robin Naundorf
+fh-muenster.io
+
// Filegear Inc. : https://www.filegear.com
// Submitted by Jason Zhu
filegear.me
@@ -11872,6 +11865,7 @@ usercontent.jp
gentapps.com
gentlentapis.com
lab.ms
+cdn-edges.net
// GitHub, Inc.
// Submitted by Patrick Toomey
@@ -11931,9 +11925,10 @@ pagespeedmobilizer.com
publishproxy.com
withgoogle.com
withyoutube.com
-cloudfunctions.net
+*.gateway.dev
cloud.goog
translate.goog
+cloudfunctions.net
blogspot.ae
blogspot.al
@@ -12056,6 +12051,10 @@ ravendb.me
development.run
ravendb.run
+// Hong Kong Productivity Council: https://www.hkpc.org/
+// Submitted by SECaaS Team
+secaas.hk
+
// HOSTBIP REGISTRY : https://www.hostbip.com/
// Submitted by Atanunu Igbunuroghene
bpl.biz
@@ -12165,7 +12164,7 @@ iserv.dev
// Submitted by Yuji Minagawa
iobb.net
-//Jelastic, Inc. : https://jelastic.com/
+// Jelastic, Inc. : https://jelastic.com/
// Submited by Ihor Kolodyuk
mel.cloudlets.com.au
cloud.interhostsolutions.be
@@ -12180,6 +12179,9 @@ jele.cloud
it1.eur.aruba.jenv-aruba.cloud
it1.jenv-aruba.cloud
it1-eur.jenv-arubabiz.cloud
+oxa.cloud
+tn.oxa.cloud
+uk.oxa.cloud
primetel.cloud
uk.primetel.cloud
ca.reclaim.cloud
@@ -12250,6 +12252,7 @@ jelastic.regruhosting.ru
enscaled.sg
jele.site
jelastic.team
+orangecloud.tn
j.layershift.co.uk
phx.enscaled.us
mircloud.us
@@ -12327,10 +12330,6 @@ co.technology
// Submitted by Greg Holland
app.lmpm.com
-// Linki Tools UG : https://linki.tools
-// Submitted by Paulo Matos
-linkitools.space
-
// linkyard ldt: https://www.linkyard.ch/
// Submitted by Mario Siegenthaler
linkyard.cloud
@@ -12369,7 +12368,6 @@ swidnik.pl
// Lug.org.uk : https://lug.org.uk
// Submitted by Jon Spriggs
-uklugs.org
glug.org.uk
lug.org.uk
lugs.org.uk
@@ -12446,11 +12444,17 @@ eu.meteorapp.com
co.pl
// Microsoft Corporation : http://microsoft.com
-// Submitted by Mostafa Elzeiny
+// Submitted by Mitch Webster
*.azurecontainer.io
azurewebsites.net
azure-mobile.net
cloudapp.net
+azurestaticapps.net
+centralus.azurestaticapps.net
+eastasia.azurestaticapps.net
+eastus2.azurestaticapps.net
+westeurope.azurestaticapps.net
+westus2.azurestaticapps.net
// minion.systems : http://minion.systems
// Submitted by Robert Böttinger
@@ -12492,19 +12496,22 @@ cust.retrosnub.co.uk
ui.nabu.casa
// Names.of.London : https://names.of.london/
-// Submitted by James Stevens or
+// Submitted by James Stevens or
pony.club
of.fashion
-on.fashion
-of.football
in.london
of.london
+from.marketing
+with.marketing
for.men
+repair.men
and.mom
for.mom
for.one
+under.one
for.sale
-of.work
+that.win
+from.work
to.work
// NCTU.ME : https://nctu.me/
@@ -12824,6 +12831,12 @@ mypep.link
// Submitted by Kenneth Van Alstyne
perspecta.cloud
+// PE Ulyanov Kirill Sergeevich : https://airy.host
+// Submitted by Kirill Ulyanov
+lk3.ru
+ra-ru.ru
+zsew.ru
+
// Planet-Work : https://www.planet-work.com/
// Submitted by Frédéric VANNIÈRE
on-web.fr
@@ -12885,6 +12898,10 @@ byen.site
// Submitted by Kor Nielsen
pubtls.org
+// QOTO, Org.
+// Submitted by Jeffrey Phillips Freeman
+qoto.io
+
// Qualifio : https://qualifio.com/
// Submitted by Xavier De Cock
qualifioapp.com
@@ -12970,7 +12987,6 @@ hzc.io
// Revitalised Limited : http://www.revitalised.co.uk
// Submitted by Jack Price
wellbeingzone.eu
-ptplus.fit
wellbeingzone.co.uk
// Rochester Institute of Technology : http://www.rit.edu/
@@ -13344,7 +13360,7 @@ wafflecell.com
// Submitted by Fajar Sodik
idnblogger.com
indowapblog.com
-bloghp.id
+bloger.id
wblog.id
wbq.me
fastblog.net
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 4315771a496..a1c6837e880 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -6063,6 +6063,7 @@ Erlang_functions (FILE *inf)
{
free (last);
last = NULL;
+ allocated = lastlen = 0;
}
}
else
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 595db1d2f8e..97314cc489f 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1225,8 +1225,8 @@ as a heading."
(apropos-print-doc 6 'apropos-face t)
(apropos-print-doc 5 'apropos-widget t)
(apropos-print-doc 4 'apropos-plist nil))
- (set (make-local-variable 'truncate-partial-width-windows) t)
- (set (make-local-variable 'truncate-lines) t))))
+ (setq-local truncate-partial-width-windows t)
+ (setq-local truncate-lines t))))
(prog1 apropos-accumulator
(setq apropos-accumulator ()))) ; permit gc
diff --git a/lisp/array.el b/lisp/array.el
index 0d1ac74432b..0ad565b5bc7 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -863,25 +863,25 @@ Entering array mode calls the function `array-mode-hook'."
(make-local-variable 'array-row)
(make-local-variable 'array-column)
(make-local-variable 'array-copy-string)
- (set (make-local-variable 'array-respect-tabs) nil)
- (set (make-local-variable 'array-max-row)
- (read-number "Number of array rows: "))
- (set (make-local-variable 'array-max-column)
- (read-number "Number of array columns: "))
- (set (make-local-variable 'array-columns-per-line)
- (read-number "Array columns per line: "))
- (set (make-local-variable 'array-field-width)
- (read-number "Field width: "))
- (set (make-local-variable 'array-rows-numbered)
- (y-or-n-p "Rows numbered? "))
- (set (make-local-variable 'array-line-length)
- (* array-field-width array-columns-per-line))
- (set (make-local-variable 'array-lines-per-row)
- (+ (floor (1- array-max-column) array-columns-per-line)
- (if array-rows-numbered 2 1)))
+ (setq-local array-respect-tabs nil)
+ (setq-local array-max-row
+ (read-number "Number of array rows: "))
+ (setq-local array-max-column
+ (read-number "Number of array columns: "))
+ (setq-local array-columns-per-line
+ (read-number "Array columns per line: "))
+ (setq-local array-field-width
+ (read-number "Field width: "))
+ (setq-local array-rows-numbered
+ (y-or-n-p "Rows numbered? "))
+ (setq-local array-line-length
+ (* array-field-width array-columns-per-line))
+ (setq-local array-lines-per-row
+ (+ (floor (1- array-max-column) array-columns-per-line)
+ (if array-rows-numbered 2 1)))
(message "")
(force-mode-line-update)
- (set (make-local-variable 'truncate-lines) t)
+ (setq-local truncate-lines t)
(setq overwrite-mode 'overwrite-mode-textual))
diff --git a/lisp/battery.el b/lisp/battery.el
index e568ab52460..f59ad124794 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -661,10 +661,12 @@ Intended as a UPower PropertiesChanged signal handler."
(cond ((stringp battery-upower-device)
(list battery-upower-device))
(battery-upower-device)
- ((dbus-call-method :system battery-upower-service
- battery-upower-path
- battery-upower-interface
- "EnumerateDevices"))))
+ ((dbus-ignore-errors
+ (dbus-call-method :system battery-upower-service
+ battery-upower-path
+ battery-upower-interface
+ "EnumerateDevices"
+ :timeout 1000)))))
(defun battery--upower-state (props state)
"Merge the UPower battery state in PROPS with STATE.
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index d06ba287879..5392519d718 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -269,8 +269,8 @@ In Buffer Menu mode, the following commands are defined:
\\[revert-buffer] Update the list of buffers.
\\[Buffer-menu-toggle-files-only] Toggle whether the menu displays only file buffers.
\\[Buffer-menu-bury] Bury the buffer listed on this line."
- (set (make-local-variable 'buffer-stale-function)
- (lambda (&optional _noconfirm) 'fast))
+ (setq-local buffer-stale-function
+ (lambda (&optional _noconfirm) 'fast))
(add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
(defun buffer-menu (&optional arg)
diff --git a/lisp/button.el b/lisp/button.el
index ba0682348df..a6f70436f74 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -613,6 +613,20 @@ button at point is the button to describe."
(button--describe props)
t)))
+(defun button-buttonize (string callback &optional data)
+ "Make STRING into a button and return it.
+When clicked, CALLBACK will be called with the DATA as the
+function argument. If DATA isn't present (or is nil), the button
+itself will be used instead as the function argument."
+ (propertize string
+ 'face 'button
+ 'button t
+ 'follow-link t
+ 'category t
+ 'button-data data
+ 'keymap button-map
+ 'action callback))
+
(provide 'button)
;;; button.el ends here
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index 60dd17e5ed2..6d935872348 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -199,48 +199,16 @@
(message "Omitting leading zeros on integers"))))
-(defvar math-power-of-2-cache (list 1 2 4 8 16 32 64 128 256 512 1024))
-(defvar math-big-power-of-2-cache nil)
(defun math-power-of-2 (n) ; [I I] [Public]
- (if (and (natnump n) (<= n 100))
- (or (nth n math-power-of-2-cache)
- (let* ((i (length math-power-of-2-cache))
- (val (nth (1- i) math-power-of-2-cache)))
- (while (<= i n)
- (setq val (math-mul val 2)
- math-power-of-2-cache (nconc math-power-of-2-cache
- (list val))
- i (1+ i)))
- val))
- (let ((found (assq n math-big-power-of-2-cache)))
- (if found
- (cdr found)
- (let ((po2 (math-ipow 2 n)))
- (setq math-big-power-of-2-cache
- (cons (cons n po2) math-big-power-of-2-cache))
- po2)))))
+ (if (natnump n)
+ (ash 1 n)
+ (error "argument must be a natural number")))
(defun math-integer-log2 (n) ; [I I] [Public]
- (let ((i 0)
- (p math-power-of-2-cache)
- val)
- (while (and p (Math-natnum-lessp (setq val (car p)) n))
- (setq p (cdr p)
- i (1+ i)))
- (if p
- (and (equal val n)
- i)
- (while (Math-natnum-lessp
- (prog1
- (setq val (math-mul val 2))
- (setq math-power-of-2-cache (nconc math-power-of-2-cache
- (list val))))
- n)
- (setq i (1+ i)))
- (and (equal val n)
- i))))
-
-
+ (and (natnump n)
+ (not (zerop n))
+ (zerop (logand n (1- n)))
+ (logb n)))
;;; Bitwise operations.
@@ -404,7 +372,7 @@
(math-clip (calcFunc-ash a n (- w)) w)
(if (Math-integer-negp a)
(setq a (math-clip a w)))
- (let ((two-to-sizem1 (math-power-of-2 (1- w)))
+ (let ((two-to-sizem1 (and (not (zerop w)) (math-power-of-2 (1- w))))
(sh (calcFunc-lsh a n w)))
(cond ((or (zerop w)
(zerop (logand a two-to-sizem1)))
@@ -438,7 +406,7 @@
(if (Math-integer-negp a)
(setq a (math-clip a w)))
(cond ((or (Math-integer-negp n)
- (not (Math-natnum-lessp n w)))
+ (>= n w))
(calcFunc-rot a (math-mod n w) w))
(t
(math-add (calcFunc-lsh a (- n w) w)
@@ -455,7 +423,7 @@
(math-reject-arg a 'integerp))
((< (or w (setq w calc-word-size)) 0)
(setq a (math-clip a (- w)))
- (if (Math-natnum-lessp a (math-power-of-2 (- -1 w)))
+ (if (< a (math-power-of-2 (- -1 w)))
a
(math-sub a (math-power-of-2 (- w)))))
((math-zerop w)
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index 5aeb8cba0df..0f6c40a663b 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -815,7 +815,7 @@
(error "Argument must be an integer"))
((Math-integer-negp n)
'(nil))
- ((Math-natnum-lessp n 8000000)
+ ((< n 8000000)
(let ((i -1) v)
(while (and (> (% n (setq v (aref math-primes-table
(setq i (1+ i)))))
@@ -913,7 +913,7 @@
(if (Math-messy-integerp n)
(setq n (math-trunc n)))
(if (Math-natnump n)
- (if (Math-natnum-lessp 2 n)
+ (if (< 2 n)
(let (factors res p (i 0))
(while (and (not (eq n 1))
(< i (length math-primes-table)))
@@ -927,7 +927,7 @@
(setq factors (nconc factors (list p))
n (car res)))
(or (eq n 1)
- (Math-natnum-lessp p (car res))
+ (< p (car res))
(setq factors (nconc factors (list n))
n 1))
(setq i (1+ i)))
@@ -946,7 +946,7 @@
(if (Math-messy-integerp n)
(setq n (math-trunc n)))
(if (Math-natnump n)
- (if (Math-natnum-lessp n 2)
+ (if (< n 2)
(if (Math-negp n)
(calcFunc-totient (math-abs n))
n)
@@ -969,7 +969,7 @@
(if (Math-messy-integerp n)
(setq n (math-trunc n)))
(if (and (Math-natnump n) (not (eq n 0)))
- (if (Math-natnum-lessp n 2)
+ (if (< n 2)
(if (Math-negp n)
(calcFunc-moebius (math-abs n))
1)
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 4877fa6e08c..7984c8bbaa2 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -2417,17 +2417,6 @@ If X is not an error form, return 1."
(mapcar #'math-normalize (cdr a))))))
-;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
-(defun math-norm-bignum (a)
- (let ((digs a) (last nil))
- (while digs
- (or (eq (car digs) 0) (setq last digs))
- (setq digs (cdr digs)))
- (and last
- (progn
- (setcdr last nil)
- a))))
-
;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
(defun calcFunc-sign (a &optional x)
(let ((signs (math-possible-signs a)))
@@ -2542,23 +2531,6 @@ If X is not an error form, return 1."
0
2))))
-;;; Compare two bignum digit lists, return -1 for AB.
-(defun math-compare-bignum (a b) ; [S l l]
- (let ((res 0))
- (while (and a b)
- (if (< (car a) (car b))
- (setq res -1)
- (if (> (car a) (car b))
- (setq res 1)))
- (setq a (cdr a)
- b (cdr b)))
- (if a
- (progn
- (while (eq (car a) 0) (setq a (cdr a)))
- (if a 1 res))
- (while (eq (car b) 0) (setq b (cdr b)))
- (if b -1 res))))
-
(defun math-compare-lists (a b)
(cond ((null a) (null b))
((null b) nil)
@@ -2685,7 +2657,7 @@ If X is not an error form, return 1."
(if (Math-integer-negp a) (setq a (math-neg a)))
(if (Math-integer-negp b) (setq b (math-neg b)))
(let (c)
- (if (Math-natnum-lessp a b)
+ (if (< a b)
(setq c b b a a c))
(while (and (consp a) (not (eq b 0)))
(setq c b
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index 9ee86e755ea..fd544f9719b 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -410,7 +410,7 @@
((and (math-num-integerp b)
(if (math-negp b)
(math-reject-arg b 'range)
- (Math-natnum-lessp (setq b (math-trunc b)) 20)))
+ (< (setq b (math-trunc b)) 20)))
(and calc-symbolic-mode (or (math-floatp a) (math-floatp b))
(math-inexact-result))
(math-mul
@@ -427,7 +427,7 @@
((and (math-num-integerp a)
(if (math-negp a)
(math-reject-arg a 'range)
- (Math-natnum-lessp (setq a (math-trunc a)) 20)))
+ (< (setq a (math-trunc a)) 20)))
(math-sub (or math-current-beta-value (calcFunc-beta a b))
(calcFunc-betaB (math-sub 1 x) b a)))
(t
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 829fa44ca4f..b694a826ce5 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -351,7 +351,7 @@
(if (>= ver 3)
(insert "set surface\nset nocontour\n"
"set " (if calc-graph-is-splot "" "no") "parametric\n"
- "set notime\nset border\nset ztics\nset zeroaxis\n"
+ "set notimestamp\nset border\nset ztics\nset zeroaxis\n"
"set view 60,30,1,1\nset offsets 0,0,0,0\n"))
(setq samples-pos (point))
(insert "\n\n" str))
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index 06ef3ef0556..a15095e3753 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -29,7 +29,6 @@
(declare-function math-looks-negp "calc-misc" (a))
(declare-function math-posp "calc-misc" (a))
(declare-function math-compare "calc-ext" (a b))
-(declare-function math-compare-bignum "calc-ext" (a b))
(defmacro calc-wrapper (&rest body)
@@ -174,13 +173,6 @@
(eq (nth 1 a) b)
(= (nth 2 a) 0))))
-(defsubst Math-natnum-lessp (a b)
- (if (consp a)
- (and (consp b)
- (= (math-compare-bignum (cdr a) (cdr b)) -1))
- (or (consp b)
- (< a b))))
-
(provide 'calc-macs)
;;; calc-macs.el ends here
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 46172d1b7f6..1d0d94e992f 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -370,18 +370,6 @@ If this can't be done, return NIL."
(math-isqrt (math-floor a))
(math-floor (math-sqrt a))))
-(defun math-zerop-bignum (a)
- (and (eq (car a) 0)
- (progn
- (while (eq (car (setq a (cdr a))) 0))
- (null a))))
-
-(defun math-scale-bignum-digit-size (a n) ; [L L S]
- (while (> n 0)
- (setq a (cons 0 a)
- n (1- n)))
- a)
-
;;; Compute the square root of a number.
;;; [T N] if possible, else [F N] if possible, else [C N]. [Public]
(defun math-sqrt (a)
@@ -666,7 +654,7 @@ If this can't be done, return NIL."
(let* ((q (math-idivmod a (math-ipow guess (1- math-nri-n))))
(s (math-add (car q) (math-mul (1- math-nri-n) guess)))
(g2 (math-idivmod s math-nri-n)))
- (if (Math-natnum-lessp (car g2) guess)
+ (if (< (car g2) guess)
(math-nth-root-int-iter a (car g2))
(cons (and (equal (car g2) guess)
(eq (cdr q) 0)
@@ -1615,7 +1603,7 @@ If this can't be done, return NIL."
(math-natnump b) (not (eq b 0)))
(if (eq b 1)
(math-reject-arg x "*Logarithm base one")
- (if (Math-natnum-lessp x b)
+ (if (< x b)
0
(cdr (math-integer-log x b))))
(math-floor (calcFunc-log x b))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 9d869f359bc..bb02281111f 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -2100,7 +2100,7 @@ the United States."
(set-buffer calc-trail-buffer)
(unless (derived-mode-p 'calc-trail-mode)
(calc-trail-mode)
- (set (make-local-variable 'calc-main-buffer) buf)))))
+ (setq-local calc-main-buffer buf)))))
(or (and calc-trail-pointer
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
(with-current-buffer calc-trail-buffer
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index e4f6e989ecf..0631eb48f9f 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1054,17 +1054,36 @@
(nth 1 a)) 185))
(calc-language 'flat)
(low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
- (high (and (nth 4 a) (math-compose-expr (nth 4 a) 0))))
+ (high (and (nth 4 a) (math-compose-expr (nth 4 a) 0)))
+ ;; Check if we have Unicode integral top/bottom parts.
+ (fancy (and (char-displayable-p ?⌠)
+ (char-displayable-p ?⌡)))
+ ;; If we do, find the most suitable middle part.
+ (fancy-stem (cond ((not fancy))
+ ;; U+23AE INTEGRAL EXTENSION
+ ((char-displayable-p ?⎮) "⎮ ")
+ ;; U+2502 BOX DRAWINGS LIGHT VERTICAL
+ ((char-displayable-p ?│) "│ ")
+ ;; U+007C VERTICAL LINE
+ (t "| "))))
(list 'horiz
(if parens "(" "")
- (append (list 'vcent (if high 3 2))
- (and high (list (list 'horiz " " high)))
- '(" /"
- " | "
- " | "
- " | "
- "/ ")
- (and low (list (list 'horiz low " "))))
+ (append (list 'vcent (if fancy
+ (if high 2 1)
+ (if high 3 2)))
+ (and high (list (if fancy
+ (list 'horiz high " ")
+ (list 'horiz " " high))))
+ (if fancy
+ (list "⌠ " fancy-stem "⌡ ")
+ '(" /"
+ " | "
+ " | "
+ " | "
+ "/ "))
+ (and low (list (if fancy
+ (list 'horiz low " ")
+ (list 'horiz low " ")))))
expr
(if over
""
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index de9b1f3ff53..d262b607796 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1788,7 +1788,7 @@ For a complete description, see the info node `Calendar/Diary'.
(setq buffer-read-only t
buffer-undo-list t
indent-tabs-mode nil)
- (set (make-local-variable 'scroll-margin) 0) ; bug#10379
+ (setq-local scroll-margin 0) ; bug#10379
(calendar-update-mode-line)
(make-local-variable 'calendar-mark-ring)
(make-local-variable 'displayed-month) ; month in middle of window
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index fbc13f59b2a..bf1e8ebf9d6 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -839,7 +839,7 @@ LIST-ONLY is non-nil, in which case it just returns the list."
(goto-char (point-min))
(unless list-only
(let ((ol (make-overlay (point-min) (point-max) nil t nil)))
- (set (make-local-variable 'diary-selective-display) t)
+ (setq-local diary-selective-display t)
(overlay-put ol 'invisible 'diary)
(overlay-put ol 'evaporate t)))
(dotimes (_ number)
@@ -2381,10 +2381,9 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
;;;###autoload
(define-derived-mode diary-mode fundamental-mode "Diary"
"Major mode for editing the diary file."
- (set (make-local-variable 'font-lock-defaults)
- '(diary-font-lock-keywords t))
- (set (make-local-variable 'comment-start) diary-comment-start)
- (set (make-local-variable 'comment-end) diary-comment-end)
+ (setq-local font-lock-defaults '(diary-font-lock-keywords t))
+ (setq-local comment-start diary-comment-start)
+ (setq-local comment-end diary-comment-end)
(add-to-invisibility-spec '(diary . nil))
(add-hook 'after-save-hook #'diary-redraw-calendar nil t)
;; In case the file was modified externally, refresh the calendar
@@ -2465,13 +2464,13 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
(define-derived-mode diary-fancy-display-mode special-mode
"Diary"
"Major mode used while displaying diary entries using Fancy Display."
- (set (make-local-variable 'font-lock-defaults)
- '(diary-fancy-font-lock-keywords
- t nil nil nil
- (font-lock-fontify-region-function
- . diary-fancy-font-lock-fontify-region-function)))
- (set (make-local-variable 'minor-mode-overriding-map-alist)
- (list (cons t diary-fancy-overriding-map)))
+ (setq-local font-lock-defaults
+ '(diary-fancy-font-lock-keywords
+ t nil nil nil
+ (font-lock-fontify-region-function
+ . diary-fancy-font-lock-fontify-region-function)))
+ (setq-local minor-mode-overriding-map-alist
+ (list (cons t diary-fancy-overriding-map)))
(view-mode 1))
;; Following code from Dave Love .
diff --git a/lisp/chistory.el b/lisp/chistory.el
index c9aa927b94f..98443bfa88f 100644
--- a/lisp/chistory.el
+++ b/lisp/chistory.el
@@ -140,7 +140,7 @@ The buffer is left in Command History mode."
Keybindings:
\\{command-history-mode-map}"
(lisp-mode-variables nil)
- (set (make-local-variable 'revert-buffer-function) 'command-history-revert)
+ (setq-local revert-buffer-function 'command-history-revert)
(set-syntax-table emacs-lisp-mode-syntax-table))
(defcustom command-history-hook nil
diff --git a/lisp/comint.el b/lisp/comint.el
index 2873416c5f4..628a93ddf95 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1224,7 +1224,7 @@ Moves relative to START, or `comint-input-ring-index'."
(process-mark (get-buffer-process (current-buffer))))
(point-max)))
-(defun comint-previous-matching-input (regexp n)
+(defun comint-previous-matching-input (regexp n &optional restore)
"Search backwards through input history for match for REGEXP.
\(Previous history elements are earlier commands.)
With prefix argument N, search for Nth previous match.
@@ -1235,16 +1235,24 @@ If N is negative, find the next or Nth next match."
;; Has a match been found?
(if (null pos)
(user-error "Not found")
- ;; If leaving the edit line, save partial input
- (if (null comint-input-ring-index) ;not yet on ring
- (setq comint-stored-incomplete-input
- (funcall comint-get-old-input)))
- (setq comint-input-ring-index pos)
- (unless isearch-mode
- (let ((message-log-max nil)) ; Do not write to *Messages*.
- (message "History item: %d" (1+ pos))))
- (comint-delete-input)
- (insert (ring-ref comint-input-ring pos)))))
+ (if (and comint-input-ring-index
+ restore
+ (or (and (< n 0)
+ (< comint-input-ring-index pos))
+ (and (> n 0)
+ (> comint-input-ring-index pos))))
+ ;; We have a wrap; restore contents.
+ (comint-restore-input)
+ ;; If leaving the edit line, save partial input
+ (if (null comint-input-ring-index) ;not yet on ring
+ (setq comint-stored-incomplete-input
+ (funcall comint-get-old-input)))
+ (setq comint-input-ring-index pos)
+ (unless isearch-mode
+ (let ((message-log-max nil)) ; Do not write to *Messages*.
+ (message "History item: %d" (1+ pos))))
+ (comint-delete-input)
+ (insert (ring-ref comint-input-ring pos))))))
(defun comint-next-matching-input (regexp n)
"Search forwards through input history for match for REGEXP.
@@ -1272,7 +1280,7 @@ If N is negative, search forwards for the -Nth following match."
comint-input-ring-index nil))
(comint-previous-matching-input
(concat "^" (regexp-quote comint-matching-input-from-input-string))
- n)
+ n t)
(when (eq comint-move-point-for-matching-input 'after-input)
(goto-char opoint))))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index d3bbcb95dc2..0e4a18cd768 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -2734,11 +2734,15 @@ try matching its doc string against `custom-guess-doc-alist'."
buttons)
(insert " ")
(let* ((format (widget-get type :format))
- tag-format value-format)
- (unless (string-match ":" format)
+ tag-format)
+ ;; We used to drop the widget tag when creating TYPE, passing
+ ;; everything after the colon (including whitespace characters
+ ;; after it) as the :format for TYPE. We don't drop the tag
+ ;; anymore, but we should keep an immediate whitespace character,
+ ;; if present, and it's easier to do it here.
+ (unless (string-match ":\\s-?" format)
(error "Bad format"))
(setq tag-format (substring format 0 (match-end 0)))
- (setq value-format (substring format (match-end 0)))
(push (widget-create-child-and-convert
widget 'item
:format tag-format
@@ -2753,7 +2757,6 @@ try matching its doc string against `custom-guess-doc-alist'."
buttons)
(push (widget-create-child-and-convert
widget type
- :format value-format
:value value)
children))))
(unless (eq custom-buffer-style 'tree)
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index a9df0314215..c8bb749eb38 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -45,7 +45,7 @@
;; dabbrev-case-replace nil t
;;
;; Set the variables you want special for your mode like this:
-;; (set (make-local-variable 'dabbrev-case-replace) nil)
+;; (setq-local dabbrev-case-replace nil)
;; Then you don't interfere with other modes.
;;
;; If your mode handles buffers that refers to other buffers
@@ -59,10 +59,10 @@
;; Example for GNUS (when we write a reply, we want dabbrev to look in
;; the article for expansion):
-;; (set (make-local-variable 'dabbrev-friend-buffer-function)
-;; (lambda (buffer)
-;; (with-current-buffer buffer
-;; (memq major-mode '(news-reply-mode gnus-article-mode)))))
+;; (setq-local dabbrev-friend-buffer-function
+;; (lambda (buffer)
+;; (with-current-buffer buffer
+;; (memq major-mode '(news-reply-mode gnus-article-mode)))))
;; Known bugs and limitations.
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 7a7f1d07c93..4be330375da 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1222,7 +1222,13 @@ This function is a no-op when Emacs is running in batch mode.
It returns t if a desktop file was loaded, nil otherwise.
\n(fn DIRNAME)"
(interactive "i\nP")
- (unless noninteractive
+ (if (or noninteractive
+ (and (desktop-owner)
+ (= (desktop-owner) (emacs-pid))))
+ (message "Not reloading the desktop%s"
+ (if noninteractive
+ ""
+ "; already loaded"))
(setq desktop-dirname
(file-name-as-directory
(expand-file-name
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 417477be27b..31e571410bc 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -280,7 +280,7 @@ CREATE-HOOK is a hook to run after creating a frame."
;; Enable mouse tracking in emacs
(if dframe-track-mouse-function
- (set (make-local-variable 'track-mouse) t)) ;this could be messy.
+ (setq-local track-mouse t)) ;this could be messy.
;; Override `temp-buffer-show-hook' so that help and such
;; put their stuff into a frame other than our own.
@@ -290,10 +290,8 @@ CREATE-HOOK is a hook to run after creating a frame."
;; FIXME: Doesn't this get us into an inf-loop when the
;; `temp-buffer-show-function' runs `temp-buffer-show-hook'
;; (as is normally the case)?
- (progn (make-local-variable 'temp-buffer-show-hook)
- (setq temp-buffer-show-hook temp-buffer-show-function)))
- (make-local-variable 'temp-buffer-show-function)
- (setq temp-buffer-show-function 'dframe-temp-buffer-show-function)
+ (setq-local temp-buffer-show-hook temp-buffer-show-function))
+ (setq-local temp-buffer-show-function 'dframe-temp-buffer-show-function)
;; If this buffer is killed, we must make sure that we destroy
;; the frame the dedicated window is in.
(add-hook 'kill-buffer-hook (lambda ()
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 26155190d47..0f68b470733 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -259,7 +259,7 @@ the string of command switches used as the third argument of `diff'."
(list
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq-local minibuffer-default-add-function nil)
(setq minibuffer-default defaults))
(read-file-name (format-prompt "Diff %s with" default current)
target-dir default t))
@@ -334,7 +334,7 @@ only in the active region if `dired-mark-region' is non-nil."
(defaults (dired-dwim-target-defaults nil target-dir)))
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq-local minibuffer-default-add-function nil)
(setq minibuffer-default defaults))
(read-directory-name (format "Compare %s with: "
(dired-current-directory))
@@ -2049,7 +2049,7 @@ Optional arg HOW-TO determines how to treat the target.
(target (expand-file-name ; fluid variable inside dired-create-files
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq-local minibuffer-default-add-function nil)
(setq minibuffer-default defaults))
(dired-mark-read-file-name
(format "%s %%s %s: "
@@ -3013,14 +3013,14 @@ is part of a file name (i.e., has the text property `dired-filename')."
(defun dired-isearch-filenames ()
"Search for a string using Isearch only in file names in the Dired buffer."
(interactive)
- (set (make-local-variable 'dired-isearch-filenames) t)
+ (setq-local dired-isearch-filenames t)
(isearch-forward nil t))
;;;###autoload
(defun dired-isearch-filenames-regexp ()
"Search for a regexp using Isearch only in file names in the Dired buffer."
(interactive)
- (set (make-local-variable 'dired-isearch-filenames) t)
+ (setq-local dired-isearch-filenames t)
(isearch-forward-regexp nil t))
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 55077e71882..75e4f466246 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -636,7 +636,7 @@ you can relist single subdirs using \\[dired-do-redisplay]."
(dired-mode dirname (or switches dired-listing-switches))
(setq mode-name "Virtual Dired"
revert-buffer-function 'dired-virtual-revert)
- (set (make-local-variable 'dired-subdir-alist) nil)
+ (setq-local dired-subdir-alist nil)
(dired-build-subdir-alist)
(goto-char (point-min))
(dired-initial-position dirname))
@@ -1226,7 +1226,7 @@ Otherwise obeys the value of `dired-vm-read-only-folders'."
(and dired-vm-read-only-folders
(not (file-writable-p fil)))))
;; So that pressing `v' inside VM does prompt within current directory:
- (set (make-local-variable 'vm-folder-directory) dir)))
+ (setq-local vm-folder-directory dir)))
(defun dired-rmail ()
"Run RMAIL on this file."
diff --git a/lisp/dired.el b/lisp/dired.el
index 30b9f5b8fa1..c68c4a52bd4 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2419,6 +2419,10 @@ If the current buffer can be edited with Wdired, (i.e. the major
mode is `dired-mode'), call `wdired-change-to-wdired-mode'.
Otherwise, toggle `read-only-mode'."
(interactive)
+ (when (and (not (file-writable-p default-directory))
+ (not (y-or-n-p
+ "Directory isn't writable; edit anyway? ")))
+ (user-error "Directory %s isn't writable" default-directory))
(if (derived-mode-p 'dired-mode)
(wdired-change-to-wdired-mode)
(read-only-mode 'toggle)))
@@ -2499,6 +2503,10 @@ directory in another window."
(defun dired-find-file ()
"In Dired, visit the file or directory named on this line."
(interactive)
+ (dired--find-file #'find-file (dired-get-file-for-visit)))
+
+(defun dired--find-file (find-file-function file)
+ "Call FIND-FILE-FUNCTION on FILE, but bind some relevant variables."
;; Bind `find-file-run-dired' so that the command works on directories
;; too, independent of the user's setting.
(let ((find-file-run-dired t)
@@ -2511,7 +2519,7 @@ directory in another window."
(if dired-auto-revert-buffer
nil
switch-to-buffer-preserve-window-point)))
- (find-file (dired-get-file-for-visit))))
+ (funcall find-file-function file)))
(defun dired-find-alternate-file ()
"In Dired, visit file or directory on current line via `find-alternate-file'.
@@ -2547,7 +2555,7 @@ respectively."
(select-window window)
(funcall find-dir-func file)))
(select-window window)
- (funcall find-file-func (file-name-sans-versions file t)))))
+ (dired--find-file find-file-func (file-name-sans-versions file t)))))
(defun dired-mouse-find-file-other-window (event)
"In Dired, visit the file or directory name you click on in another window."
@@ -2574,7 +2582,7 @@ Otherwise, display it in another buffer."
(defun dired-find-file-other-window ()
"In Dired, visit this file or directory in another window."
(interactive)
- (find-file-other-window (dired-get-file-for-visit)))
+ (dired--find-file #'find-file-other-window (dired-get-file-for-visit)))
(defun dired-display-file ()
"In Dired, display this file or directory in another window."
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 9997c1ae7b8..f7a7be96b3d 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -2055,7 +2055,7 @@ See the command `doc-view-mode' for more information on this mode."
:init-value nil :keymap doc-view-presentation-mode-map
(if doc-view-presentation-mode
(progn
- (set (make-local-variable 'mode-line-format) nil)
+ (setq-local mode-line-format nil)
(doc-view-fit-page-to-window)
;; (doc-view-convert-all-pages)
)
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index 079fce88def..cf7b28a1e80 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -202,8 +202,7 @@ Electric Buffer Menu mode is a minor mode which is automatically
enabled and disabled by the \\[electric-buffer-list] command.
See the documentation of `electric-buffer-list' for details."
(setq mode-line-buffer-identification "Electric Buffer List")
- (set (make-local-variable 'Helper-return-blurb)
- "return to buffer editing"))
+ (setq-local Helper-return-blurb "return to buffer editing"))
(define-obsolete-function-alias 'Electric-buffer-menu-mode
'electric-buffer-menu-mode "24.3")
@@ -270,8 +269,8 @@ Return to Electric Buffer Menu when done."
(when (derived-mode-p 'electric-buffer-menu-mode)
;; Make sure we have an overlay to use.
(or electric-buffer-overlay
- (set (make-local-variable 'electric-buffer-overlay)
- (make-overlay (point) (point))))
+ (setq-local electric-buffer-overlay
+ (make-overlay (point) (point))))
(move-overlay electric-buffer-overlay
(line-beginning-position)
(line-end-position))
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 44cf5aad387..8ff766cee99 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -151,9 +151,9 @@ With a prefix argument, format the macro in a more concise way."
(setq buffer-read-only nil)
(setq major-mode 'edmacro-mode)
(setq mode-name "Edit Macro")
- (set (make-local-variable 'edmacro-original-buffer) oldbuf)
- (set (make-local-variable 'edmacro-finish-hook) finish-hook)
- (set (make-local-variable 'edmacro-store-hook) store-hook)
+ (setq-local edmacro-original-buffer oldbuf)
+ (setq-local edmacro-finish-hook finish-hook)
+ (setq-local edmacro-store-hook store-hook)
(erase-buffer)
(insert ";; Keyboard Macro Editor. Press C-c C-c to finish; "
"press C-x k RET to cancel.\n")
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 0acd5276977..e23bb9f5e6e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -144,7 +144,7 @@ is hard-coded in various places in Emacs.)"
;; Eg is_elc in Fload.
:type 'regexp)
-(defcustom byte-compile-dest-file-function nil
+(defcustom byte-compile-dest-file-function #'byte-compile--default-dest-file
"Function for the function `byte-compile-dest-file' to call.
It should take one argument, the name of an Emacs Lisp source
file name, and return the name of the compiled file.
@@ -177,14 +177,16 @@ function to do the work. Otherwise, if FILENAME matches
`emacs-lisp-file-regexp' (by default, files with the extension \".el\"),
replaces the matching part (and anything after it) with \".elc\";
otherwise adds \".elc\"."
- (if byte-compile-dest-file-function
- (funcall byte-compile-dest-file-function filename)
- (setq filename (file-name-sans-versions
- (byte-compiler-base-file-name filename)))
- (cond ((string-match emacs-lisp-file-regexp filename)
- (concat (substring filename 0 (match-beginning 0)) ".elc"))
- (t (concat filename ".elc")))))
-)
+ (funcall (or byte-compile-dest-file-function
+ #'byte-compile--default-dest-file)
+ filename)))
+
+(defun byte-compile--default-dest-file (filename)
+ (setq filename (file-name-sans-versions
+ (byte-compiler-base-file-name filename)))
+ (cond ((string-match emacs-lisp-file-regexp filename)
+ (concat (substring filename 0 (match-beginning 0)) ".elc"))
+ (t (concat filename ".elc"))))
;; This can be the 'byte-compile property of any symbol.
(autoload 'byte-compile-inline-expand "byte-opt")
@@ -1809,24 +1811,23 @@ If compilation is needed, this functions returns the result of
(let ((dest (byte-compile-dest-file filename))
;; Expand now so we get the current buffer's defaults
(filename (expand-file-name filename)))
- (if (if (file-exists-p dest)
- ;; File was already compiled
- ;; Compile if forced to, or filename newer
- (or force
- (file-newer-than-file-p filename dest))
- (and arg
- (or (eq 0 arg)
- (y-or-n-p (concat "Compile "
- filename "? ")))))
- (progn
- (if (and noninteractive (not byte-compile-verbose))
- (message "Compiling %s..." filename))
- (byte-compile-file filename)
- (when load
- (load (if (file-exists-p dest) dest filename))))
+ (prog1
+ (if (if (and dest (file-exists-p dest))
+ ;; File was already compiled
+ ;; Compile if forced to, or filename newer
+ (or force
+ (file-newer-than-file-p filename dest))
+ (and arg
+ (or (eq 0 arg)
+ (y-or-n-p (concat "Compile "
+ filename "? ")))))
+ (progn
+ (if (and noninteractive (not byte-compile-verbose))
+ (message "Compiling %s..." filename))
+ (byte-compile-file filename))
+ 'no-byte-compile)
(when load
- (load (if (file-exists-p dest) dest filename)))
- 'no-byte-compile)))
+ (load (if (and dest (file-exists-p dest)) dest filename))))))
(defun byte-compile--load-dynvars (file)
(and file (not (equal file ""))
@@ -1936,7 +1937,7 @@ See also `emacs-lisp-byte-compile-and-load'."
;; (message "%s not compiled because of `no-byte-compile: %s'"
;; (byte-compile-abbreviate-file filename)
;; (with-current-buffer input-buffer no-byte-compile))
- (when (file-exists-p target-file)
+ (when (and target-file (file-exists-p target-file))
(message "%s deleted because of `no-byte-compile: %s'"
(byte-compile-abbreviate-file target-file)
(buffer-local-value 'no-byte-compile input-buffer))
@@ -1960,36 +1961,50 @@ See also `emacs-lisp-byte-compile-and-load'."
(with-current-buffer output-buffer
(goto-char (point-max))
(insert "\n") ; aaah, unix.
- (if (file-writable-p target-file)
- ;; We must disable any code conversion here.
- (progn
- (let* ((coding-system-for-write 'no-conversion)
- ;; Write to a tempfile so that if another Emacs
- ;; process is trying to load target-file (eg in a
- ;; parallel bootstrap), it does not risk getting a
- ;; half-finished file. (Bug#4196)
- (tempfile
- (make-temp-file (expand-file-name target-file)))
- (default-modes (default-file-modes))
- (temp-modes (logand default-modes #o600))
- (desired-modes (logand default-modes #o666))
- (kill-emacs-hook
- (cons (lambda () (ignore-errors
- (delete-file tempfile)))
- kill-emacs-hook)))
- (unless (= temp-modes desired-modes)
- (set-file-modes tempfile desired-modes 'nofollow))
- (write-region (point-min) (point-max) tempfile nil 1)
- ;; This has the intentional side effect that any
- ;; hard-links to target-file continue to
- ;; point to the old file (this makes it possible
- ;; for installed files to share disk space with
- ;; the build tree, without causing problems when
- ;; emacs-lisp files in the build tree are
- ;; recompiled). Previously this was accomplished by
- ;; deleting target-file before writing it.
- (rename-file tempfile target-file t))
- (or noninteractive (message "Wrote %s" target-file)))
+ (cond
+ ((null target-file) nil) ;We only wanted the warnings!
+ ((and (file-writable-p target-file)
+ ;; We attempt to create a temporary file in the
+ ;; target directory, so the target directory must be
+ ;; writable.
+ (file-writable-p (file-name-directory target-file)))
+ ;; We must disable any code conversion here.
+ (let* ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile
+ (make-temp-file (expand-file-name target-file)))
+ (default-modes (default-file-modes))
+ (temp-modes (logand default-modes #o600))
+ (desired-modes (logand default-modes #o666))
+ (kill-emacs-hook
+ (cons (lambda () (ignore-errors
+ (delete-file tempfile)))
+ kill-emacs-hook)))
+ (unless (= temp-modes desired-modes)
+ (set-file-modes tempfile desired-modes 'nofollow))
+ (write-region (point-min) (point-max) tempfile nil 1)
+ ;; This has the intentional side effect that any
+ ;; hard-links to target-file continue to
+ ;; point to the old file (this makes it possible
+ ;; for installed files to share disk space with
+ ;; the build tree, without causing problems when
+ ;; emacs-lisp files in the build tree are
+ ;; recompiled). Previously this was accomplished by
+ ;; deleting target-file before writing it.
+ (rename-file tempfile target-file t))
+ (or noninteractive (message "Wrote %s" target-file)))
+ ((file-writable-p target-file)
+ ;; In case the target directory isn't writable (see e.g. Bug#44631),
+ ;; try writing to the output file directly. We must disable any
+ ;; code conversion here.
+ (let ((coding-system-for-write 'no-conversion))
+ (with-file-modes (logand (default-file-modes) #o666)
+ (write-region (point-min) (point-max) target-file nil 1)))
+ (or noninteractive (message "Wrote %s" target-file)))
+ (t
;; This is just to give a better error message than write-region
(let ((exists (file-exists-p target-file)))
(signal (if exists 'file-error 'file-missing)
@@ -1997,7 +2012,7 @@ See also `emacs-lisp-byte-compile-and-load'."
(if exists
"Cannot overwrite file"
"Directory not writable or nonexistent")
- target-file))))
+ target-file)))))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 02da07daaf4..b37b05b9a3a 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -410,8 +410,18 @@ the specializer used will be the one returned by BODY."
;;;###autoload
(defmacro cl-defmethod (name args &rest body)
"Define a new method for generic function NAME.
-I.e. it defines the implementation of NAME to use for invocations where the
-values of the dispatch arguments match the specified TYPEs.
+This it defines an implementation of NAME to use for invocations
+of specific types of arguments.
+
+ARGS is a list of dispatch arguments (see `cl-defun'), but where
+each variable element is either just a single variable name VAR,
+or a list on the form (VAR TYPE).
+
+For instance:
+
+ (cl-defmethod foo (bar (format-string string) &optional zot)
+ (format format-string bar))
+
The dispatch arguments have to be among the mandatory arguments, and
all methods of NAME have to use the same set of arguments for dispatch.
Each dispatch argument and TYPE are specified in ARGS where the corresponding
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index d81060ef165..6a976841038 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -467,7 +467,6 @@ This holds the results of the last documentation request."
(defun eldoc--format-doc-buffer (docs)
"Ensure DOCS are displayed in an *eldoc* buffer."
- (interactive (list t))
(with-current-buffer (if (buffer-live-p eldoc--doc-buffer)
eldoc--doc-buffer
(setq eldoc--doc-buffer
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index ef97c8279d7..79b72ff969f 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -558,7 +558,8 @@ Return nil if there are no more forms, t otherwise."
(when . elint-check-conditional-form)
(unless . elint-check-conditional-form)
(and . elint-check-conditional-form)
- (or . elint-check-conditional-form))
+ (or . elint-check-conditional-form)
+ (require . elint-require-form))
"Functions to call when some special form should be linted.")
(defun elint-form (form env &optional nohandler)
@@ -953,6 +954,13 @@ Does basic handling of `featurep' tests."
(elint-form form env t))))
env)
+(defun elint-require-form (form _env)
+ "Load `require'd files."
+ (pcase form
+ (`(require ',x)
+ (require x)))
+ nil)
+
;;;
;;; Message functions
;;;
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 5f29c2665a3..25237feae2a 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -274,7 +274,7 @@ DATA is displayed to the user and should state the reason for skipping."
It should only be stopped when ran from inside ert--run-test-internal."
(when (and (not (symbolp debugger)) ; only run on anonymous debugger
(memq error-symbol '(ert-test-failed ert-test-skipped)))
- (funcall debugger 'error data)))
+ (funcall debugger 'error (list error-symbol data))))
(defun ert--special-operator-p (thing)
"Return non-nil if THING is a symbol naming a special operator."
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 081ef8d441a..e477ef17000 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -38,7 +38,7 @@
(define-abbrev-table 'lisp-mode-abbrev-table ()
"Abbrev table for Lisp mode.")
-(defvar lisp--mode-syntax-table
+(defvar lisp-data-mode-syntax-table
(let ((table (make-syntax-table))
(i 0))
(while (< i ?0)
@@ -77,11 +77,13 @@
(modify-syntax-entry ?\\ "\\ " table)
(modify-syntax-entry ?\( "() " table)
(modify-syntax-entry ?\) ")( " table)
+ (modify-syntax-entry ?\[ "(]" table)
+ (modify-syntax-entry ?\] ")[" table)
table)
"Parent syntax table used in Lisp modes.")
(defvar lisp-mode-syntax-table
- (let ((table (make-syntax-table lisp--mode-syntax-table)))
+ (let ((table (make-syntax-table lisp-data-mode-syntax-table)))
(modify-syntax-entry ?\[ "_ " table)
(modify-syntax-entry ?\] "_ " table)
(modify-syntax-entry ?# "' 14" table)
@@ -669,7 +671,7 @@ font-lock keywords will not be case sensitive."
(define-derived-mode lisp-data-mode prog-mode "Lisp-Data"
"Major mode for buffers holding data written in Lisp syntax."
:group 'lisp
- (lisp-mode-variables t t nil)
+ (lisp-mode-variables nil t nil)
(setq-local electric-quote-string t)
(setq imenu-case-fold-search nil))
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
new file mode 100644
index 00000000000..04ae87d9ea0
--- /dev/null
+++ b/lisp/emacs-lisp/memory-report.el
@@ -0,0 +1,303 @@
+;;; memory-report.el --- Short function summaries -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Keywords: lisp, help
+
+;; 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 .
+
+;;; Commentary:
+
+;; Todo (possibly): Font cache, regexp cache, bidi cache, various
+;; buffer caches (newline cache, free_region_cache, etc), composition
+;; cache, face cache.
+
+;;; Code:
+
+(require 'seq)
+(require 'subr-x)
+(eval-when-compile (require 'cl-lib))
+
+(defvar memory-report--type-size (make-hash-table))
+
+;;;###autoload
+(defun memory-report ()
+ "Generate a report of how Emacs is using memory.
+
+This report is approximate, and will commonly over-count memory
+usage by variables, because shared data structures will usually
+by counted more than once."
+ (interactive)
+ (pop-to-buffer "*Memory Report*")
+ (special-mode)
+ (button-mode 1)
+ (setq truncate-lines t)
+ (message "Gathering data...")
+ (let ((reports (append (memory-report--garbage-collect)
+ (memory-report--image-cache)
+ (memory-report--buffers)
+ (memory-report--largest-variables)))
+ (inhibit-read-only t)
+ summaries details)
+ (message "Gathering data...done")
+ (erase-buffer)
+ (insert (propertize "Estimated Emacs Memory Usage\n\n" 'face 'bold))
+ (dolist (report reports)
+ (if (listp report)
+ (push report summaries)
+ (push report details)))
+ (dolist (summary (seq-sort (lambda (e1 e2)
+ (> (cdr e1) (cdr e2)))
+ summaries))
+ (insert (format "%s %s\n"
+ (memory-report--format (cdr summary))
+ (car summary))))
+ (insert "\n")
+ (dolist (detail (nreverse details))
+ (insert detail "\n")))
+ (goto-char (point-min)))
+
+(defun memory-report-object-size (object)
+ "Return the size of OBJECT in bytes."
+ (unless memory-report--type-size
+ (memory-report--garbage-collect))
+ (memory-report--object-size (make-hash-table :test #'eq) object))
+
+(defun memory-report--size (type)
+ (or (gethash type memory-report--type-size)
+ (gethash 'object memory-report--type-size)))
+
+(defun memory-report--set-size (elems)
+ (setf (gethash 'string memory-report--type-size)
+ (cadr (assq 'strings elems)))
+ (setf (gethash 'cons memory-report--type-size)
+ (cadr (assq 'conses elems)))
+ (setf (gethash 'symbol memory-report--type-size)
+ (cadr (assq 'symbols elems)))
+ (setf (gethash 'object memory-report--type-size)
+ (cadr (assq 'vectors elems)))
+ (setf (gethash 'float memory-report--type-size)
+ (cadr (assq 'floats elems)))
+ (setf (gethash 'buffer memory-report--type-size)
+ (cadr (assq 'buffers elems))))
+
+(defun memory-report--garbage-collect ()
+ (let ((elems (garbage-collect)))
+ (memory-report--set-size elems)
+ (let ((data (list
+ (list 'strings
+ (+ (memory-report--gc-elem elems 'strings)
+ (memory-report--gc-elem elems 'string-bytes)))
+ (list 'vectors
+ (+ (memory-report--gc-elem elems 'vectors)
+ (memory-report--gc-elem elems 'vector-slots)))
+ (list 'floats (memory-report--gc-elem elems 'floats))
+ (list 'conses (memory-report--gc-elem elems 'conses))
+ (list 'symbols (memory-report--gc-elem elems 'symbols))
+ (list 'intervals (memory-report--gc-elem elems 'intervals))
+ (list 'buffer-objects
+ (memory-report--gc-elem elems 'buffers)))))
+ (list (cons "Overall Object Memory Usage"
+ (seq-reduce #'+ (mapcar (lambda (elem)
+ (* (nth 1 elem) (nth 2 elem)))
+ elems)
+ 0))
+ (cons "Reserved (But Unused) Object Memory"
+ (seq-reduce #'+ (mapcar (lambda (elem)
+ (if (nth 3 elem)
+ (* (nth 1 elem) (nth 3 elem))
+ 0))
+ elems)
+ 0))
+ (with-temp-buffer
+ (insert (propertize "Object Storage\n\n" 'face 'bold))
+ (dolist (object (seq-sort (lambda (e1 e2)
+ (> (cadr e1) (cadr e2)))
+ data))
+ (insert (format "%s %s\n"
+ (memory-report--format (cadr object))
+ (capitalize (symbol-name (car object))))))
+ (buffer-string))))))
+
+(defun memory-report--largest-variables ()
+ (let ((variables nil))
+ (mapatoms
+ (lambda (symbol)
+ (when (boundp symbol)
+ (let ((size (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (symbol-value symbol))))
+ (when (> size 1000)
+ (push (cons symbol size) variables)))))
+ obarray)
+ (list
+ (cons (propertize "Memory Used By Global Variables"
+ 'help-echo "Upper bound; mutually overlapping data from different variables are counted several times")
+ (seq-reduce #'+ (mapcar #'cdr variables) 0))
+ (with-temp-buffer
+ (insert (propertize "Largest Variables\n\n" 'face 'bold))
+ (cl-loop for i from 1 upto 20
+ for (symbol . size) in (seq-sort (lambda (e1 e2)
+ (> (cdr e1) (cdr e2)))
+ variables)
+ do (insert (memory-report--format size)
+ " "
+ (symbol-name symbol)
+ "\n"))
+ (buffer-string)))))
+
+(defun memory-report--object-size (counted value)
+ (if (gethash value counted)
+ 0
+ (setf (gethash value counted) t)
+ (memory-report--object-size-1 counted value)))
+
+(cl-defgeneric memory-report--object-size-1 (_counted _value)
+ 0)
+
+(cl-defmethod memory-report--object-size-1 (_ (value symbol))
+ ;; Don't count global symbols -- makes sizes of lists of symbols too
+ ;; heavey.
+ (if (intern-soft value obarray)
+ 0
+ (memory-report--size 'symbol)))
+
+(cl-defmethod memory-report--object-size-1 (_ (_value buffer))
+ (memory-report--size 'buffer))
+
+(cl-defmethod memory-report--object-size-1 (counted (value string))
+ (+ (memory-report--size 'string)
+ (string-bytes value)
+ (memory-report--interval-size counted (object-intervals value))))
+
+(defun memory-report--interval-size (counted intervals)
+ ;; We get a list back of intervals, but only count the "inner list"
+ ;; (i.e., the actual text properties), and add the size of the
+ ;; intervals themselves.
+ (+ (* (memory-report--size 'interval) (length intervals))
+ (seq-reduce #'+ (mapcar
+ (lambda (interval)
+ (memory-report--object-size counted (nth 2 interval)))
+ intervals)
+ 0)))
+
+(cl-defmethod memory-report--object-size-1 (counted (value list))
+ (let ((total 0)
+ (size (memory-report--size 'cons)))
+ (while value
+ (cl-incf total size)
+ (setf (gethash value counted) t)
+ (when (car value)
+ (cl-incf total (memory-report--object-size counted (car value))))
+ (if (cdr value)
+ (if (consp (cdr value))
+ (setq value (cdr value))
+ (cl-incf total (memory-report--object-size counted (cdr value)))
+ (setq value nil))
+ (setq value nil)))
+ total))
+
+(cl-defmethod memory-report--object-size-1 (counted (value vector))
+ (let ((total (+ (memory-report--size 'vector)
+ (* (memory-report--size 'object) (length value)))))
+ (cl-loop for elem across value
+ do (setf (gethash elem counted) t)
+ (cl-incf total (memory-report--object-size counted elem)))
+ total))
+
+(cl-defmethod memory-report--object-size-1 (counted (value hash-table))
+ (let ((total (+ (memory-report--size 'vector)
+ (* (memory-report--size 'object) (hash-table-size value)))))
+ (maphash
+ (lambda (key elem)
+ (setf (gethash key counted) t)
+ (setf (gethash elem counted) t)
+ (cl-incf total (memory-report--object-size counted key))
+ (cl-incf total (memory-report--object-size counted elem)))
+ value)
+ total))
+
+(defun memory-report--format (bytes)
+ (setq bytes (/ bytes 1024.0))
+ (let ((units '("kB" "MB" "GB" "TB")))
+ (while (>= bytes 1024)
+ (setq bytes (/ bytes 1024.0))
+ (setq units (cdr units)))
+ (format "%6.1f%s" bytes (car units))))
+
+(defun memory-report--gc-elem (elems type)
+ (* (nth 1 (assq type elems))
+ (nth 2 (assq type elems))))
+
+(defun memory-report--buffers ()
+ (let ((buffers (mapcar (lambda (buffer)
+ (cons buffer (memory-report--buffer buffer)))
+ (buffer-list))))
+ (list (cons "Total Buffer Memory Usage"
+ (seq-reduce #'+ (mapcar #'cdr buffers) 0))
+ (with-temp-buffer
+ (insert (propertize "Largest Buffers\n\n" 'face 'bold))
+ (cl-loop for i from 1 upto 20
+ for (buffer . size) in (seq-sort (lambda (e1 e2)
+ (> (cdr e1) (cdr e2)))
+ buffers)
+ do (insert (memory-report--format size)
+ " "
+ (button-buttonize
+ (buffer-name buffer)
+ #'memory-report--buffer-details buffer)
+ "\n"))
+ (buffer-string)))))
+
+(defun memory-report--buffer-details (buffer)
+ (with-current-buffer buffer
+ (apply
+ #'message
+ "Buffer text: %s; variables: %s; text properties: %s; overlays: %s"
+ (mapcar #'string-trim (mapcar #'memory-report--format
+ (memory-report--buffer-data buffer))))))
+
+(defun memory-report--buffer (buffer)
+ (seq-reduce #'+ (memory-report--buffer-data buffer) 0))
+
+(defun memory-report--buffer-data (buffer)
+ (with-current-buffer buffer
+ (list (save-restriction
+ (widen)
+ (+ (position-bytes (point-max))
+ (- (position-bytes (point-min)))
+ (gap-size)))
+ (seq-reduce #'+ (mapcar (lambda (elem)
+ (if (cdr elem)
+ (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (cdr elem))
+ 0))
+ (buffer-local-variables buffer))
+ 0)
+ (memory-report--object-size (make-hash-table :test #'eq)
+ (object-intervals buffer))
+ (memory-report--object-size (make-hash-table :test #'eq)
+ (overlay-lists)))))
+
+(defun memory-report--image-cache ()
+ (list (cons "Total Image Cache Size" (if (fboundp 'image-cache-size)
+ (image-cache-size)
+ 0))))
+
+(provide 'memory-report)
+
+;;; memory-report.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 9c37ce429a7..b7c48dfd3f5 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1115,14 +1115,15 @@ boundaries."
;; Use some headers we've invented to drive the process.
(let* (;; Prefer Package-Version; if defined, the package author
;; probably wants us to use it. Otherwise try Version.
- (pkg-version
- (or (package-strip-rcs-id (lm-header "package-version"))
- (package-strip-rcs-id (lm-header "version"))))
+ (version-info
+ (or (lm-header "package-version") (lm-header "version")))
+ (pkg-version (package-strip-rcs-id version-info))
(keywords (lm-keywords-list))
(homepage (lm-homepage)))
(unless pkg-version
- (error
- "Package lacks a \"Version\" or \"Package-Version\" header"))
+ (if version-info
+ (error "Unrecognized package version: %s" version-info)
+ (error "Package lacks a \"Version\" or \"Package-Version\" header")))
(package-desc-from-define
file-name pkg-version desc
(and-let* ((require-lines (lm-header-multiline "package-requires")))
@@ -2112,7 +2113,10 @@ Otherwise return nil."
(when str
(when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
(setq str (substring str (match-end 0))))
- (if (version-to-list str) str)))
+ (let ((l (version-to-list str)))
+ ;; Don't return `str' but (package-version-join (version-to-list str))
+ ;; to make sure we use a "canonical name"!
+ (if l (package-version-join l)))))
(declare-function lm-homepage "lisp-mnt" (&optional file))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index e603900b095..206f0dd1a9d 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -409,7 +409,8 @@ of the elements of LIST is performed as if by `pcase-let'.
(dolist (case cases)
(unless (or (memq case used-cases)
(memq (car case) pcase--dontwarn-upats))
- (message "Redundant pcase pattern: %S" (car case))))
+ (message "pcase pattern %S shadowed by previous pcase pattern"
+ (car case))))
(macroexp-let* defs main))))
(defun pcase--macroexpand (pat)
diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el
index c8e483e9a4a..cd42152527e 100644
--- a/lisp/emacs-lisp/thunk.el
+++ b/lisp/emacs-lisp/thunk.el
@@ -122,7 +122,7 @@ Using `thunk-let' and `thunk-let*' requires `lexical-binding'."
(declare (indent 1) (debug let))
(cl-reduce
(lambda (expr binding) `(thunk-let (,binding) ,expr))
- (nreverse bindings)
+ (reverse bindings)
:initial-value (macroexp-progn body)))
;; (defalias 'lazy-let #'thunk-let)
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index b29ad7702ef..f61de9208d1 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -788,7 +788,7 @@ Argument NUM is the number of lines to delete."
In select mode, selected text is highlighted."
(if arg
(progn
- (set (make-local-variable 'edt-select-mode) 'edt-select-mode-current)
+ (setq-local edt-select-mode 'edt-select-mode-current)
(setq rect-start-point (window-point)))
(progn
(kill-local-variable 'edt-select-mode)))
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index dd7648c2b77..938ebb15227 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -474,7 +474,7 @@
;; Modifies mode-line-buffer-identification.
(defun viper-refresh-mode-line ()
- (set (make-local-variable 'viper-mode-string)
+ (setq-local viper-mode-string
(cond ((eq viper-current-state 'emacs-state) viper-emacs-state-id)
((eq viper-current-state 'vi-state) viper-vi-state-id)
((eq viper-current-state 'replace-state) viper-replace-state-id)
@@ -1865,14 +1865,10 @@ Undo previous insertion and inserts new."
;; minibuffer and vice versa. Otherwise, command arguments will affect
;; minibuffer ops and insertions from the minibuffer will change those in
;; the normal buffers
- (make-local-variable 'viper-d-com)
- (make-local-variable 'viper-last-insertion)
- (make-local-variable 'viper-command-ring)
- (setq viper-d-com nil
- viper-last-insertion nil
- viper-command-ring nil)
- (funcall hook)
- ))
+ (setq-local viper-d-com nil)
+ (setq-local viper-last-insertion nil)
+ (setq-local viper-command-ring nil)
+ (funcall hook)))
;; This is a temp hook that uses free variables viper--init-message and viper-initial.
;; A dirty feature, but it is the simplest way to have it do the right thing.
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 59ca6298eb9..851092819c8 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -617,7 +617,7 @@ This startup message appears whenever you load Viper, unless you type `y' now."
;; This hook designed to enable Vi-style editing in comint-based modes."
(defun viper-comint-mode-hook ()
- (set (make-local-variable 'require-final-newline) nil)
+ (setq-local require-final-newline nil)
(setq viper-ex-style-editing nil
viper-ex-style-motion nil)
(viper-change-state-to-insert))
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index 7fd41784746..21dc1ebaff0 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -309,7 +309,8 @@ encryption is used."
If no one is selected, symmetric encryption will be performed. "
recipients)
(if epa-file-encrypt-to
- (epg-list-keys context recipients)))))
+ (epg--filter-revoked-keys
+ (epg-list-keys context recipients))))))
(error
(epa-display-error context)
(if (setq entry (assoc file epa-file-passphrase-alist))
diff --git a/lisp/epg.el b/lisp/epg.el
index 920b85398f3..b27e2c638c2 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1382,6 +1382,13 @@ NAME is either a string or a list of strings."
(setq pointer (cdr pointer)))
keys))
+(defun epg--filter-revoked-keys (keys)
+ (seq-remove (lambda (key)
+ (seq-find (lambda (user)
+ (eq (epg-user-id-validity user) 'revoked))
+ (epg-key-user-id-list key)))
+ keys))
+
(defun epg--args-from-sig-notations (notations)
(apply #'nconc
(mapcar
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index 4ccd463aff2..13bbb5284a3 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -446,7 +446,7 @@ local, and sets it to FACE."
(setq specs (car specs)))
(if (null specs)
(buffer-face-mode 0)
- (set (make-local-variable 'buffer-face-mode-face) specs)
+ (setq-local buffer-face-mode-face specs)
(buffer-face-mode t)))
;;;###autoload
@@ -470,7 +470,7 @@ buffer local, and set it to SPECS."
(if (or (null specs)
(and buffer-face-mode (equal buffer-face-mode-face specs)))
(buffer-face-mode 0)
- (set (make-local-variable 'buffer-face-mode-face) specs)
+ (setq-local buffer-face-mode-face specs)
(buffer-face-mode t)))
(defun buffer-face-mode-invoke (specs arg &optional interactive)
diff --git a/lisp/files.el b/lisp/files.el
index 2cf77d5d7e9..093b5f92e58 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -597,7 +597,7 @@ settings being applied, but still respect file-local ones.")
;; This is an odd variable IMO.
;; You might wonder why it is needed, when we could just do:
-;; (set (make-local-variable 'enable-local-variables) nil)
+;; (setq-local enable-local-variables nil)
;; These two are not precisely the same.
;; Setting this variable does not cause -*- mode settings to be
;; ignored, whereas setting enable-local-variables does.
@@ -2419,9 +2419,7 @@ Do you want to revisit the file normally now? ")))
;; this is a permanent local, the major mode won't eliminate it.
(and backup-enable-predicate
(not (funcall backup-enable-predicate buffer-file-name))
- (progn
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t)))
+ (setq-local backup-inhibited t))
(if rawfile
(progn
(set-buffer-multibyte nil)
@@ -3520,7 +3518,7 @@ n -- to ignore the local variables list.")
(let ((print-escape-newlines t))
(prin1 (cdr elt) buf))
(insert "\n"))
- (set (make-local-variable 'cursor-type) nil)
+ (setq-local cursor-type nil)
(set-buffer-modified-p nil)
(goto-char (point-min)))
@@ -4492,9 +4490,7 @@ the old visited file has been renamed to the new name FILENAME."
(and buffer-file-name
backup-enable-predicate
(not (funcall backup-enable-predicate buffer-file-name))
- (progn
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t)))
+ (setq-local backup-inhibited t))
(let ((oauto buffer-auto-save-file-name))
(cond ((null filename)
(setq buffer-auto-save-file-name nil))
@@ -6123,6 +6119,9 @@ This undoes all changes since the file was visited or saved.
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
+Reverting a buffer will try to preserve markers in the buffer;
+see the Info node `(elisp)Reverting' for details.
+
This command also implements an interface for special buffers
that contain text that doesn't come from a file, but reflects
some other data instead (e.g. Dired buffers, `buffer-list'
@@ -6219,7 +6218,7 @@ Non-file buffers need a custom function."
;; Run after-revert-hook as it was before we reverted.
(setq-default revert-buffer-internal-hook global-hook)
(if local-hook
- (set (make-local-variable 'revert-buffer-internal-hook)
+ (setq-local revert-buffer-internal-hook
local-hook)
(kill-local-variable 'revert-buffer-internal-hook))
(run-hooks 'revert-buffer-internal-hook))
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 883871c4d80..62dc5a54d53 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1336,8 +1336,7 @@ Use the viewer defined in EV-ENTRY (a valid element of
(progn
(switch-to-buffer (format "Filesets: %s %s" vwr file))
(insert output)
- (make-local-variable 'filesets-output-buffer-flag)
- (setq filesets-output-buffer-flag t)
+ (setq-local filesets-output-buffer-flag t)
(set-visited-file-name file t)
(when oh
(run-hooks 'oh))
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index 18330d821ce..d2b82bdd51c 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -223,11 +223,10 @@ it finishes, type \\[kill-find]."
(set-keymap-parent map (current-local-map))
(define-key map "\C-c\C-k" 'kill-find)
(use-local-map map))
- (make-local-variable 'dired-sort-inhibit)
- (setq dired-sort-inhibit t)
- (set (make-local-variable 'revert-buffer-function)
- `(lambda (ignore-auto noconfirm)
- (find-dired ,dir ,find-args)))
+ (setq-local dired-sort-inhibit t)
+ (setq-local revert-buffer-function
+ `(lambda (ignore-auto noconfirm)
+ (find-dired ,dir ,find-args)))
;; Set subdir-alist so that Tree Dired will work:
(if (fboundp 'dired-simple-subdir-alist)
;; will work even with nested dired format (dired-nstd.el,v 1.15
@@ -235,9 +234,9 @@ it finishes, type \\[kill-find]."
(dired-simple-subdir-alist)
;; else we have an ancient tree dired (or classic dired, where
;; this does no harm)
- (set (make-local-variable 'dired-subdir-alist)
- (list (cons default-directory (point-min-marker)))))
- (set (make-local-variable 'dired-subdir-switches) find-ls-subdir-switches)
+ (setq-local dired-subdir-alist
+ (list (cons default-directory (point-min-marker)))))
+ (setq-local dired-subdir-switches find-ls-subdir-switches)
(setq buffer-read-only nil)
;; Subdir headlerline must come first because the first marker in
;; subdir-alist points there.
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index c1be5ff403d..44a2e6d7371 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -212,21 +212,17 @@ It is a function which takes two arguments, the directory and its parent."
(use-local-map (append (make-sparse-keymap) (current-local-map)))
- (make-local-variable 'find-lisp-file-predicate)
- (setq find-lisp-file-predicate file-predicate)
- (make-local-variable 'find-lisp-directory-predicate)
- (setq find-lisp-directory-predicate directory-predicate)
- (make-local-variable 'find-lisp-regexp)
- (setq find-lisp-regexp regexp)
+ (setq-local find-lisp-file-predicate file-predicate)
+ (setq-local find-lisp-directory-predicate directory-predicate)
+ (setq-local find-lisp-regexp regexp)
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function
- (lambda (_ignore1 _ignore2)
- (find-lisp-insert-directory
- default-directory
- find-lisp-file-predicate
- find-lisp-directory-predicate
- 'ignore)))
+ (setq-local revert-buffer-function
+ (lambda (_ignore1 _ignore2)
+ (find-lisp-insert-directory
+ default-directory
+ find-lisp-file-predicate
+ find-lisp-directory-predicate
+ 'ignore)))
;; Set subdir-alist so that Tree Dired will work:
(if (fboundp 'dired-simple-subdir-alist)
@@ -235,8 +231,8 @@ It is a function which takes two arguments, the directory and its parent."
(dired-simple-subdir-alist)
;; else we have an ancient tree dired (or classic dired, where
;; this does no harm)
- (set (make-local-variable 'dired-subdir-alist)
- (list (cons default-directory (point-min-marker)))))
+ (setq-local dired-subdir-alist
+ (list (cons default-directory (point-min-marker)))))
(find-lisp-insert-directory
dir file-predicate directory-predicate 'ignore)
(goto-char (point-min))
diff --git a/lisp/finder.el b/lisp/finder.el
index a59a185cc9b..98859f6a395 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -448,7 +448,7 @@ FILE should be in a form suitable for passing to `locate-library'."
:syntax-table finder-mode-syntax-table
(setq buffer-read-only t
buffer-undo-list t)
- (set (make-local-variable 'finder-headmark) nil))
+ (setq-local finder-headmark nil))
(defun finder-summary ()
"Summarize basic Finder commands."
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 098253eb162..1b15d8cd30e 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -160,8 +160,8 @@ this function onto `change-major-mode-hook'."
(defun font-lock-default-function (mode)
;; Turn on Font Lock mode.
(when mode
- (set (make-local-variable 'char-property-alias-alist)
- (copy-tree char-property-alias-alist))
+ (setq-local char-property-alias-alist
+ (copy-tree char-property-alias-alist))
;; Add `font-lock-face' as an alias for the `face' property.
(let ((elt (assq 'face char-property-alias-alist)))
(if elt
@@ -171,8 +171,8 @@ this function onto `change-major-mode-hook'."
;; Turn off Font Lock mode.
(unless mode
;; Remove `font-lock-face' as an alias for the `face' property.
- (set (make-local-variable 'char-property-alias-alist)
- (copy-tree char-property-alias-alist))
+ (setq-local char-property-alias-alist
+ (copy-tree char-property-alias-alist))
(let ((elt (assq 'face char-property-alias-alist)))
(when elt
(setcdr elt (remq 'font-lock-face (cdr elt)))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index e708e69bd59..0e771e8e0a5 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -152,8 +152,8 @@
;;
;; (add-hook 'foo-mode-hook
;; (lambda ()
-;; (set (make-local-variable 'font-lock-defaults)
-;; '(foo-font-lock-keywords t))))
+;; (setq-local font-lock-defaults
+;; '(foo-font-lock-keywords t))))
;;;; Adding Font Lock support for modes:
@@ -173,8 +173,8 @@
;;
;; and within `bar-mode' there could be:
;;
-;; (set (make-local-variable 'font-lock-defaults)
-;; '(bar-font-lock-keywords nil t))
+;; (setq-local font-lock-defaults
+;; '(bar-font-lock-keywords nil t))
;; What is fontification for? You might say, "It's to make my code look nice."
;; I think it should be for adding information in the form of cues. These cues
@@ -733,7 +733,7 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
;; font-lock-mode it only enabled the font-core.el part, not the
;; font-lock-mode-internal. Try again.
(font-lock-mode -1)
- (set (make-local-variable 'font-lock-defaults) '(nil t))
+ (setq-local font-lock-defaults '(nil t))
(font-lock-mode 1))
;; Otherwise set or add the keywords now.
;; This is a no-op if it has been done already in this buffer
@@ -933,18 +933,15 @@ The value of this variable is used when Font Lock mode is turned on."
;; Prepare for jit-lock
(remove-hook 'after-change-functions
#'font-lock-after-change-function t)
- (set (make-local-variable 'font-lock-flush-function)
- #'jit-lock-refontify)
- (set (make-local-variable 'font-lock-ensure-function)
- #'jit-lock-fontify-now)
+ (setq-local font-lock-flush-function #'jit-lock-refontify)
+ (setq-local font-lock-ensure-function #'jit-lock-fontify-now)
;; Prevent font-lock-fontify-buffer from fontifying eagerly the whole
;; buffer. This is important for things like CWarn mode which
;; adds/removes a few keywords and does a refontify (which takes ages on
;; large files).
- (set (make-local-variable 'font-lock-fontify-buffer-function)
- #'jit-lock-refontify)
+ (setq-local font-lock-fontify-buffer-function #'jit-lock-refontify)
;; Don't fontify eagerly (and don't abort if the buffer is large).
- (set (make-local-variable 'font-lock-fontified) t)
+ (setq-local font-lock-fontified t)
;; Use jit-lock.
(jit-lock-register #'font-lock-fontify-region
(not font-lock-keywords-only))
@@ -1558,7 +1555,7 @@ START should be at the beginning of a line."
(unless parse-sexp-lookup-properties
;; We wouldn't go through so much trouble if we didn't intend to use those
;; properties, would we?
- (set (make-local-variable 'parse-sexp-lookup-properties) t))
+ (setq-local parse-sexp-lookup-properties t))
;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords.
(when (symbolp font-lock-syntactic-keywords)
(setq font-lock-syntactic-keywords (font-lock-eval-keywords
@@ -1942,8 +1939,8 @@ Sets various variables using `font-lock-defaults' and
(set (make-local-variable (car x)) (cdr x)))
;; Set up `font-lock-keywords' last because its value might depend
;; on other settings.
- (set (make-local-variable 'font-lock-keywords)
- (font-lock-eval-keywords keywords))
+ (setq-local font-lock-keywords
+ (font-lock-eval-keywords keywords))
;; Local fontification?
(while local
(font-lock-add-keywords nil (car (car local)) (cdr (car local)))
diff --git a/lisp/format.el b/lisp/format.el
index 905ca2d9ec9..16456eb5877 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -237,9 +237,8 @@ For most purposes, consider using `format-encode-region' instead."
;; delete the buffer once the write is done, but do
;; it after running to-fn so it doesn't affect
;; write-region calls in to-fn.
- (set (make-local-variable
- 'write-region-post-annotation-function)
- 'kill-buffer)))
+ (setq-local write-region-post-annotation-function
+ #'kill-buffer)))
nil)
;; Otherwise just call function, it will return annotations.
(funcall to-fn from to orig-buf)))))
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 053e7ea1f6b..d6802a35d0c 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -454,7 +454,7 @@ manipulated as follows:
(symbol-name major-mode))
(match-string 1 (symbol-name major-mode))))
(mode (intern (format "gnus-agent-%s-mode" buffer))))
- (set (make-local-variable 'gnus-agent-mode) t)
+ (setq-local gnus-agent-mode t)
(set mode nil)
(set (make-local-variable mode) t)
;; Set up the menu.
@@ -1056,8 +1056,8 @@ article's mark is toggled."
(defun gnus-agent-get-undownloaded-list ()
"Construct list of articles that have not been downloaded."
(let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (set (make-local-variable 'gnus-newsgroup-agentized)
- (gnus-agent-method-p gnus-command-method))
+ (when (setq-local gnus-newsgroup-agentized
+ (gnus-agent-method-p gnus-command-method))
(let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
(headers (sort (mapcar (lambda (h)
(mail-header-number h))
@@ -1440,7 +1440,7 @@ downloaded into the agent."
(let ((file (gnus-agent-lib-file "history")))
(when (file-exists-p file)
(nnheader-insert-file-contents file))
- (set (make-local-variable 'gnus-agent-file-name) file))))
+ (setq-local gnus-agent-file-name file))))
(defun gnus-agent-close-history ()
(when (gnus-buffer-live-p gnus-agent-current-history)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 7f594c9c360..5b50bcbbe1f 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3850,8 +3850,7 @@ This format is defined by the `gnus-article-time-format' variable."
(unless gnus-article-emphasis-alist
(let ((name (and gnus-newsgroup-name
(gnus-group-real-name gnus-newsgroup-name))))
- (make-local-variable 'gnus-article-emphasis-alist)
- (setq gnus-article-emphasis-alist
+ (setq-local gnus-article-emphasis-alist
(nconc
(let ((alist gnus-group-highlight-words-alist) elem highlight)
(while (setq elem (pop alist))
@@ -4495,10 +4494,10 @@ commands:
(when (gnus-visual-p 'article-menu 'menu)
(gnus-article-make-menu-bar)
(when gnus-summary-tool-bar-map
- (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
+ (setq-local tool-bar-map gnus-summary-tool-bar-map)))
(gnus-update-format-specifications nil 'article-mode)
- (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
- (set (make-local-variable 'gnus-page-broken) nil)
+ (setq-local page-delimiter gnus-page-delimiter)
+ (setq-local gnus-page-broken nil)
(make-local-variable 'gnus-article-current-summary)
(make-local-variable 'gnus-article-mime-handles)
(make-local-variable 'gnus-article-decoded-p)
@@ -4507,13 +4506,12 @@ commands:
(make-local-variable 'gnus-article-image-alist)
(make-local-variable 'gnus-article-charset)
(make-local-variable 'gnus-article-ignored-charsets)
- (set (make-local-variable 'bookmark-make-record-function)
- 'gnus-summary-bookmark-make-record)
+ (setq-local bookmark-make-record-function 'gnus-summary-bookmark-make-record)
;; Prevent Emacs from displaying non-break space with
;; `nobreak-space' face.
- (set (make-local-variable 'nobreak-char-display) nil)
+ (setq-local nobreak-char-display nil)
;; Enable `gnus-article-remove-images' to delete images shr.el renders.
- (set (make-local-variable 'shr-put-image-function) 'gnus-shr-put-image)
+ (setq-local shr-put-image-function 'gnus-shr-put-image)
(unless gnus-article-show-cursor
(setq cursor-in-non-selected-windows nil))
(gnus-set-default-directory)
@@ -4557,7 +4555,7 @@ commands:
t)))
(let ((summary gnus-summary-buffer))
(with-current-buffer name
- (set (make-local-variable 'gnus-article-edit-mode) nil)
+ (setq-local gnus-article-edit-mode nil)
(gnus-article-stop-animations)
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)
@@ -4568,14 +4566,14 @@ commands:
(setq buffer-read-only t)
(unless (derived-mode-p 'gnus-article-mode)
(gnus-article-mode))
- (set (make-local-variable 'gnus-summary-buffer) summary)
+ (setq-local gnus-summary-buffer summary)
(setq truncate-lines gnus-article-truncate-lines)
(current-buffer)))
(let ((summary gnus-summary-buffer))
(with-current-buffer (gnus-get-buffer-create name)
(gnus-article-mode)
(setq truncate-lines gnus-article-truncate-lines)
- (set (make-local-variable 'gnus-summary-buffer) summary)
+ (setq-local gnus-summary-buffer summary)
(gnus-summary-set-local-parameters gnus-newsgroup-name)
(when article-lapsed-timer
(gnus-stop-date-timer))
@@ -5036,7 +5034,7 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
(setq gnus-article-mime-handles nil)
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
- (set (make-local-variable 'mml-buffer-list) mbl1))
+ (setq-local mml-buffer-list mbl1))
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
`(lambda (no-highlight)
(let ((mail-parse-charset (or gnus-article-charset
@@ -6902,8 +6900,8 @@ then we display only bindings that start with that prefix."
(setq draft gnus-draft-mode)))
(with-temp-buffer
(use-local-map keymap)
- (set (make-local-variable 'gnus-agent-summary-mode) agent)
- (set (make-local-variable 'gnus-draft-mode) draft)
+ (setq-local gnus-agent-summary-mode agent)
+ (setq-local gnus-draft-mode draft)
(describe-bindings prefix))
(let ((item `((lambda (prefix)
(with-current-buffer ,(current-buffer)
@@ -7247,10 +7245,9 @@ This is an extended text-mode.
\\{gnus-article-edit-mode-map}"
(make-local-variable 'gnus-article-edit-done-function)
(make-local-variable 'gnus-prev-winconf)
- (set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t))
- (set (make-local-variable 'mail-header-separator) "")
- (set (make-local-variable 'gnus-article-edit-mode) t)
+ (setq-local font-lock-defaults '(message-font-lock-keywords t))
+ (setq-local mail-header-separator "")
+ (setq-local gnus-article-edit-mode t)
(mml-mode)
(setq buffer-read-only nil)
(buffer-enable-undo)
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index f0c4d07ca93..d832d0ebae1 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -49,18 +49,15 @@ if that value is non-nil."
;; Emacs stuff:
(when (and (facep 'custom-button-face)
(facep 'custom-button-pressed-face))
- (set (make-local-variable 'widget-button-face)
- 'custom-button-face)
- (set (make-local-variable 'widget-button-pressed-face)
- 'custom-button-pressed-face)
- (set (make-local-variable 'widget-mouse-face)
- 'custom-button-pressed-face))
+ (setq-local widget-button-face 'custom-button-face)
+ (setq-local widget-button-pressed-face 'custom-button-pressed-face)
+ (setq-local widget-mouse-face 'custom-button-pressed-face))
(when (and (boundp 'custom-raised-buttons)
(symbol-value 'custom-raised-buttons))
- (set (make-local-variable 'widget-push-button-prefix) "")
- (set (make-local-variable 'widget-push-button-suffix) "")
- (set (make-local-variable 'widget-link-prefix) "")
- (set (make-local-variable 'widget-link-suffix) "")))
+ (setq-local widget-push-button-prefix "")
+ (setq-local widget-push-button-suffix "")
+ (setq-local widget-link-prefix "")
+ (setq-local widget-link-suffix "")))
;;; Group Customization:
@@ -380,10 +377,8 @@ category."))
(gnus-kill-buffer "*Gnus Customize*")
(switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
(gnus-custom-mode)
- (make-local-variable 'gnus-custom-group)
- (setq gnus-custom-group group)
- (make-local-variable 'gnus-custom-topic)
- (setq gnus-custom-topic topic)
+ (setq-local gnus-custom-group group)
+ (setq-local gnus-custom-topic topic)
(buffer-disable-undo)
(widget-insert "Customize the ")
(if group
@@ -848,8 +843,7 @@ This can be changed using the `\\[gnus-score-change-score-file]' command."
(kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
(switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
(gnus-custom-mode)
- (make-local-variable 'gnus-custom-score-alist)
- (setq gnus-custom-score-alist scores)
+ (setq-local gnus-custom-score-alist scores)
(widget-insert "Customize the ")
(widget-create 'info-link
:help-echo "Push me to learn more."
@@ -867,8 +861,7 @@ Check the [ ] for the entries you want to apply to this score file, then
edit the value to suit your taste. Don't forget to mark the checkbox,
if you do all your changes will be lost. ")
(widget-insert "\n\n")
- (make-local-variable 'gnus-custom-scores)
- (setq gnus-custom-scores
+ (setq-local gnus-custom-scores
(widget-create 'group
:value scores
`(checklist :inline t
@@ -1052,10 +1045,9 @@ articles in the thread.
"\n Note: Empty fields default to the customizable global\
variables.\n\n")
- (set (make-local-variable 'gnus-agent-cat-name)
- name))
+ (setq-local gnus-agent-cat-name name))
- (set (make-local-variable 'category-fields) nil)
+ (setq-local category-fields nil)
(gnus-agent-cat-prepare-category-field agent-predicate)
(gnus-agent-cat-prepare-category-field agent-score)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 73fda66fb6b..24534a1b66d 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1098,7 +1098,7 @@ When FORCE, rebuild the tool bar."
gnus-group-tool-bar-zap-list
'gnus-group-mode-map)))
(if map
- (set (make-local-variable 'tool-bar-map) map))))
+ (setq-local tool-bar-map map))))
gnus-group-tool-bar-map)
(define-derived-mode gnus-group-mode gnus-mode "Group"
@@ -1745,7 +1745,8 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
(prog1
(setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification
- (list mode-string)))
+ (list (propertize mode-string
+ 'face 'mode-line-buffer-id))))
(set-buffer-modified-p modified))))))
(defun gnus-group-group-name ()
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 465871eafbd..3733babfe0f 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -464,8 +464,7 @@ only affect the Gcc copy, but not the original message."
(gnus-inews-add-send-actions ,winconf ,buffer ,oarticle ,config
,yanked ,winconf-name)
(setq gnus-message-buffer (current-buffer))
- (set (make-local-variable 'gnus-message-group-art)
- (cons ,group ,article))
+ (setq-local gnus-message-group-art (cons ,group ,article))
;; Enable highlighting of different citation levels
(when gnus-message-highlight-citation
(gnus-message-citation-mode 1))
@@ -473,7 +472,7 @@ only affect the Gcc copy, but not the original message."
(if (eq major-mode 'message-mode)
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl) ;; Global value
- (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
+ (setq-local mml-buffer-list mbl1) ;; Local value
(add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
(mml-destroy-buffers)
@@ -724,10 +723,10 @@ network. The corresponding back end must have a `request-post' method."
(gnus-setup-message 'message
(progn
(message-news (gnus-group-real-name gnus-newsgroup-name))
- (set (make-local-variable 'gnus-discouraged-post-methods)
- (remove
- (car (gnus-find-method-for-group gnus-newsgroup-name))
- gnus-discouraged-post-methods)))))))))
+ (setq-local gnus-discouraged-post-methods
+ (remove
+ (car (gnus-find-method-for-group gnus-newsgroup-name))
+ gnus-discouraged-post-methods)))))))))
(defun gnus-summary-post-news (&optional arg)
"Start composing a message. Post to the current group by default.
@@ -1926,8 +1925,8 @@ this is a reply."
(message-goto-body)
(insert ,(cdr result)))))
((eq 'signature (car result))
- (set (make-local-variable 'message-signature) nil)
- (set (make-local-variable 'message-signature-file) nil)
+ (setq-local message-signature nil)
+ (setq-local message-signature-file nil)
(if (not (cdr result))
'ignore
`(lambda ()
@@ -1953,8 +1952,8 @@ this is a reply."
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
- (set (make-local-variable 'user-mail-address)
- ,(or (cdr address) user-mail-address))
+ (setq-local user-mail-address
+ ,(or (cdr address) user-mail-address))
(let ((user-full-name ,(or (cdr name) (user-full-name)))
(user-mail-address
,(or (cdr address) user-mail-address)))
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 65bcd0e8a36..31aee0364cf 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -54,6 +54,9 @@
;; (: gnus-registry-split-fancy-with-parent)
+;; This won't work as expected unless `gnus-registry-register-all'
+;; is set to t.
+
;; You should also consider using the nnregistry backend to look up
;; articles. See the Gnus manual for more information.
@@ -160,6 +163,11 @@ nnmairix groups are specifically excluded because they are ephemeral."
(const :tag "Always Install" t)
(const :tag "Ask Me" ask)))
+(defcustom gnus-registry-register-all nil
+ "If non-nil, register all articles in the registry."
+ :type 'boolean
+ :version "28.1")
+
(defvar gnus-registry-enabled nil)
(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
@@ -478,8 +486,8 @@ This is not required after changing `gnus-registry-cache-file'."
(let ((db gnus-registry-db)
;; if the group is ignored, set the destination to nil (same as delete)
(to (if (gnus-registry-ignore-group-p to) nil to))
- ;; safe if not found
- (entry (gnus-registry-get-or-make-entry id))
+ ;; Only retrieve an existing entry, don't create a new one.
+ (entry (gnus-registry-get-or-make-entry id t))
(subject (gnus-string-remove-all-properties
(gnus-registry-simplify-subject subject)))
(sender (gnus-string-remove-all-properties sender)))
@@ -488,29 +496,30 @@ This is not required after changing `gnus-registry-cache-file'."
;; several times but it's better to bunch the transactions
;; together
- (registry-delete db (list id) nil)
- (when from
- (setq entry (cons (delete from (assoc 'group entry))
- (assq-delete-all 'group entry))))
- ;; Only keep the entry if the message is going to a new group, or
- ;; it's still in some previous group.
- (when (or to (alist-get 'group entry))
- (dolist (kv `((group ,to)
- (sender ,sender)
- (recipient ,@recipients)
- (subject ,subject)))
- (when (cadr kv)
- (let ((new (or (assq (car kv) entry)
- (list (car kv)))))
- (dolist (toadd (cdr kv))
- (unless (member toadd new)
- (setq new (append new (list toadd)))))
- (setq entry (cons new
- (assq-delete-all (car kv) entry))))))
- (gnus-message 10 "Gnus registry: new entry for %s is %S"
- id
- entry)
- (gnus-registry-insert db id entry))))
+ (when entry
+ (registry-delete db (list id) nil)
+ (when from
+ (setq entry (cons (delete from (assoc 'group entry))
+ (assq-delete-all 'group entry))))
+ ;; Only keep the entry if the message is going to a new group, or
+ ;; it's still in some previous group.
+ (when (or to (alist-get 'group entry))
+ (dolist (kv `((group ,to)
+ (sender ,sender)
+ (recipient ,@recipients)
+ (subject ,subject)))
+ (when (cadr kv)
+ (let ((new (or (assq (car kv) entry)
+ (list (car kv)))))
+ (dolist (toadd (cdr kv))
+ (unless (member toadd new)
+ (setq new (append new (list toadd)))))
+ (setq entry (cons new
+ (assq-delete-all (car kv) entry))))))
+ (gnus-message 10 "Gnus registry: new entry for %s is %S"
+ id
+ entry)
+ (gnus-registry-insert db id entry)))))
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
@@ -846,7 +855,8 @@ Overrides existing keywords with FORCE set non-nil."
(defun gnus-registry-register-message-ids ()
"Register the Message-ID of every article in the group."
- (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
+ (unless (or (gnus-parameter-registry-ignore gnus-newsgroup-name)
+ (null gnus-registry-register-all))
(dolist (article gnus-newsgroup-articles)
(let* ((id (gnus-registry-fetch-message-id-fast article))
(groups (gnus-registry-get-id-key id 'group)))
@@ -1082,12 +1092,15 @@ only the last one's marks are returned."
"Get the number of groups of a message, based on the message ID."
(length (gnus-registry-get-id-key id 'group)))
-(defun gnus-registry-get-or-make-entry (id)
+(defun gnus-registry-get-or-make-entry (id &optional no-create)
+ "Return registry entry for ID.
+If entry is not found, create a new one, unless NO-create is
+non-nil."
(let* ((db gnus-registry-db)
;; safe if not found
(entries (registry-lookup db (list id))))
- (when (null entries)
+ (unless (or entries no-create)
(gnus-registry-insert db id (list (list 'creation-time (current-time))
'(group) '(sender) '(subject)))
(setq entries (registry-lookup db (list id))))
@@ -1098,7 +1111,8 @@ only the last one's marks are returned."
(registry-delete gnus-registry-db idlist nil))
(defun gnus-registry-get-id-key (id key)
- (cdr-safe (assq key (gnus-registry-get-or-make-entry id))))
+ (cdr-safe (assq key (gnus-registry-get-or-make-entry
+ id (null gnus-registry-register-all)))))
(defun gnus-registry-set-id-key (id key vals)
(let* ((db gnus-registry-db)
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index 8d58cd59e45..f19678a634a 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -106,7 +106,7 @@ It accepts the same format specs that `gnus-summary-line-format' does."
(remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message))
(t
;; Make sure that we don't select any articles upon group entry.
- (set (make-local-variable 'gnus-auto-select-first) nil)
+ (setq-local gnus-auto-select-first nil)
;; Change line format.
(setq gnus-summary-line-format gnus-summary-pick-line-format)
(setq gnus-summary-line-format-spec nil)
@@ -114,7 +114,7 @@ It accepts the same format specs that `gnus-summary-line-format' does."
(gnus-update-summary-mark-positions)
;; FIXME: a buffer-local minor mode adding globally to a hook??
(add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
- (set (make-local-variable 'gnus-summary-goto-unread) 'never)
+ (setq-local gnus-summary-goto-unread 'never)
;; Set up the menu.
(when (gnus-visual-p 'pick-menu 'menu)
(gnus-pick-make-menu-bar)))))
@@ -333,10 +333,8 @@ This must be bound to a button-down mouse event."
((not (derived-mode-p 'gnus-summary-mode)) (setq gnus-binary-mode nil))
(gnus-binary-mode
;; Make sure that we don't select any articles upon group entry.
- (make-local-variable 'gnus-auto-select-first)
- (setq gnus-auto-select-first nil)
- (make-local-variable 'gnus-summary-display-article-function)
- (setq gnus-summary-display-article-function 'gnus-binary-display-article)
+ (setq-local gnus-auto-select-first nil)
+ (setq-local gnus-summary-display-article-function 'gnus-binary-display-article)
;; Set up the menu.
(when (gnus-visual-p 'binary-menu 'menu)
(gnus-binary-make-menu-bar)))))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 2e3abe7832d..94f2cc310fa 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1117,8 +1117,7 @@ EXTRA is the possible non-standard header."
(gnus-configure-windows 'edit-score)
(gnus-score-mode)
(setq gnus-score-edit-exit-function 'gnus-score-edit-done)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf))
+ (setq-local gnus-prev-winconf winconf))
(gnus-message
4 "%s" (substitute-command-keys
"\\\\[gnus-score-edit-exit] to save edits"))))
@@ -1145,8 +1144,7 @@ EXTRA is the possible non-standard header."
(gnus-configure-windows 'edit-score)
(gnus-score-mode)
(setq gnus-score-edit-exit-function 'gnus-score-edit-done)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf))
+ (setq-local gnus-prev-winconf winconf))
(gnus-message
4 "%s" (substitute-command-keys
"\\\\[gnus-score-edit-exit] to save edits")))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 89d8cff9257..0e67fac002d 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -105,6 +105,8 @@
(define-error 'gnus-search-parse-error "Gnus search parsing error")
+(define-error 'gnus-search-config-error "Gnus search configuration error")
+
;;; User Customizable Variables:
(defgroup gnus-search nil
@@ -1852,8 +1854,10 @@ Assume \"size\" key is equal to \"larger\"."
(grouplist (or groups (gnus-search-get-active server)))
(buffer (slot-value engine 'proc-buffer)))
(unless directory
- (error "No directory found in method specification of server %s"
- server))
+ (signal 'gnus-search-config-error
+ (list (format-message
+ "No directory found in definition of server %s"
+ server))))
(apply
'vconcat
(mapcar (lambda (x)
@@ -1885,7 +1889,9 @@ Assume \"size\" key is equal to \"larger\"."
group nil t)))
group))))))
(unless group
- (error "Cannot locate directory for group"))
+ (signal 'gnus-search-config-error
+ (list
+ "Cannot locate directory for group")))
(save-excursion
(apply
'call-process "find" nil t
@@ -1934,12 +1940,19 @@ Assume \"size\" key is equal to \"larger\"."
(limit (alist-get 'limit prepared-query)))
(mapc
(pcase-lambda (`(,server . ,groups))
- (let ((search-engine (gnus-search-server-to-engine server)))
- (setq results
- (vconcat
- (gnus-search-run-search
- search-engine server prepared-query groups)
- results))))
+ (condition-case err
+ (let ((search-engine (gnus-search-server-to-engine server)))
+ (setq results
+ (vconcat
+ (gnus-search-run-search
+ search-engine server prepared-query groups)
+ results)))
+ (gnus-search-config-error
+ (if (< 1 (length (alist-get 'search-group-spec specs)))
+ (apply #'nnheader-message 4
+ "Search engine for %s improperly configured: %s"
+ server (cdr err))
+ (signal 'gnus-search-config-error err)))))
(alist-get 'search-group-spec specs))
;; Some search engines do their own limiting, but some don't, so
;; do it again here. This is bad because, if the user is
@@ -1949,7 +1962,7 @@ Assume \"size\" key is equal to \"larger\"."
;; from a later group entirely.
(if limit
(seq-subseq results 0 (min limit (length results)))
- results)))
+ results)))
(defun gnus-search-prepare-query (query-spec)
"Accept a search query in raw format, and prepare it.
@@ -2023,11 +2036,13 @@ remaining string, then adds all that to the top-level spec."
(condition-case nil
(setf (slot-value inst key) value)
((invalid-slot-name invalid-slot-type)
- (nnheader-message
- 5 "Invalid search engine parameter: (%s %s)"
+ (nnheader-report 'search
+ "Invalid search engine parameter: (%s %s)"
key value)))))
(push (cons srv inst) gnus-search-engine-instance-alist))
- (error "No search engine defined for %s" srv))
+ (signal 'gnus-search-config-error
+ (list (format-message
+ "No search engine configured for %s" srv))))
inst))
(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 6beb543e5a1..ba15f1a04cc 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -262,8 +262,7 @@ The following commands are available:
(setq mode-line-process nil)
(buffer-disable-undo)
(setq truncate-lines t)
- (set (make-local-variable 'font-lock-defaults)
- '(gnus-server-font-lock-keywords t)))
+ (setq-local font-lock-defaults '(gnus-server-font-lock-keywords t)))
(defun gnus-server-insert-server-line (name method)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 615f8dfa877..d15fc8217ab 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -741,8 +741,7 @@ of an NNTP server to use. As opposed to \\[gnus], this command
will not connect to the local server."
(let ((val (or arg (1- gnus-level-default-subscribed))))
(gnus val t child)
- (make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels val)))
+ (setq-local gnus-group-use-permanent-levels val)))
(defun gnus-1 (&optional arg dont-connect child)
"Read network news.
@@ -875,13 +874,13 @@ If REGEXP is given, lines that match it will be deleted."
(with-current-buffer (setq gnus-dribble-buffer
(gnus-get-buffer-create
(file-name-nondirectory dribble-file)))
- (set (make-local-variable 'file-precious-flag) t)
+ (setq-local file-precious-flag t)
(setq buffer-save-without-query t)
(erase-buffer)
(setq buffer-file-name dribble-file)
;; The buffer may be shrunk a lot when deleting old entries.
;; It caused the auto-saving to stop.
- (set (make-local-variable 'auto-save-include-big-deletions) t)
+ (setq-local auto-save-include-big-deletions t)
(auto-save-mode t)
(buffer-disable-undo)
(bury-buffer (current-buffer))
@@ -2763,8 +2762,7 @@ values from `gnus-newsrc-hashtb', and write a new value of
;; Save .newsrc.eld.
(set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
- (make-local-variable 'version-control)
- (setq version-control gnus-backup-startup-file)
+ (setq-local version-control gnus-backup-startup-file)
(setq buffer-file-name
(concat gnus-current-startup-file ".eld"))
(setq default-directory (file-name-directory buffer-file-name))
@@ -2973,8 +2971,7 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
(when ranges
(insert ",")))))
(insert "\n")))
- (make-local-variable 'version-control)
- (setq version-control 'never)
+ (setq-local version-control 'never)
;; It has been reported that sometime the modtime on the .newsrc
;; file seems to be off. We really do want to overwrite it, so
;; we clear the modtime here before saving. It's a bit odd,
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 469fa36fb77..9488b324878 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1460,8 +1460,8 @@ the normal Gnus MIME machinery."
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
(?R gnus-tmp-replied ?c)
- (?\[ gnus-tmp-opening-bracket ?c)
- (?\] gnus-tmp-closing-bracket ?c)
+ (?\[ gnus-tmp-opening-bracket ?s)
+ (?\] gnus-tmp-closing-bracket ?s)
(?\> (make-string gnus-tmp-level ? ) ?s)
(?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
(?i gnus-tmp-score ?d)
@@ -3038,7 +3038,7 @@ When FORCE, rebuild the tool bar."
;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
;; uses its value.
(setq gnus-summary-tool-bar-map map))))
- (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
+ (setq-local tool-bar-map gnus-summary-tool-bar-map))
(defun gnus-make-score-map (type)
"Make a summary score map of type TYPE."
@@ -3174,8 +3174,8 @@ The following commands are available:
(make-local-variable 'gnus-original-article-buffer)
(add-hook 'pre-command-hook #'gnus-set-global-variables nil t)
(mm-enable-multibyte)
- (set (make-local-variable 'bookmark-make-record-function)
- #'gnus-summary-bookmark-make-record))
+ (setq-local bookmark-make-record-function
+ #'gnus-summary-bookmark-make-record))
(defun gnus-summary-make-local-variables ()
"Make all the local summary buffer variables."
@@ -3547,7 +3547,7 @@ Returns non-nil if the setup was successful."
(let ((gnus-summary-mode-group group))
(gnus-summary-mode))
(when (gnus-group-quit-config group)
- (set (make-local-variable 'gnus-single-article-buffer) nil))
+ (setq-local gnus-single-article-buffer nil))
(turn-on-gnus-mailing-list-mode)
;; These functions don't currently depend on GROUP, but might in
;; the future.
@@ -3748,6 +3748,30 @@ buffer that was in action when the last article was fetched."
(inline
(gnus-summary-extract-address-component gnus-tmp-from))))))
+(defcustom gnus-sum-opening-bracket "["
+ "With %[ spec, used to identify normal (non-adopted) articles."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-summary-format)
+
+(defcustom gnus-sum-closing-bracket "]"
+ "With %] spec, used to identify normal (non-adopted) articles."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-summary-format)
+
+(defcustom gnus-sum-opening-bracket-adopted "<"
+ "With %[ spec, used to identify adopted articles."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-summary-format)
+
+(defcustom gnus-sum-closing-bracket-adopted ">"
+ "With %] spec, used to identify adopted articles."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-summary-format)
+
(defun gnus-summary-insert-line (header level current undownloaded
unread replied expirable subject-or-nil
&optional dummy score process)
@@ -3805,8 +3829,14 @@ buffer that was in action when the last article was fetched."
(1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from)))
(gnus-tmp-subject (mail-header-subject gnus-tmp-header))
- (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
- (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
+ (gnus-tmp-opening-bracket
+ (if gnus-tmp-dummy
+ gnus-sum-opening-bracket-adopted
+ gnus-sum-opening-bracket))
+ (gnus-tmp-closing-bracket
+ (if gnus-tmp-dummy
+ gnus-sum-closing-bracket-adopted
+ gnus-sum-closing-bracket))
(inhibit-read-only t))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
@@ -5439,10 +5469,10 @@ or a straight list of headers."
(if (and (eq gnus-summary-make-false-root 'adopt)
(= gnus-tmp-level 1)
(memq number gnus-tmp-gathered))
- (setq gnus-tmp-opening-bracket ?\<
- gnus-tmp-closing-bracket ?\>)
- (setq gnus-tmp-opening-bracket ?\[
- gnus-tmp-closing-bracket ?\]))
+ (setq gnus-tmp-opening-bracket gnus-sum-opening-bracket-adopted
+ gnus-tmp-closing-bracket gnus-sum-closing-bracket-adopted)
+ (setq gnus-tmp-opening-bracket gnus-sum-opening-bracket
+ gnus-tmp-closing-bracket gnus-sum-closing-bracket))
(if (>= gnus-tmp-level (length gnus-thread-indent-array))
(gnus-make-thread-indent-array
(max (* 2 (length gnus-thread-indent-array))
@@ -5670,8 +5700,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
articles fetched-articles cached)
(unless (gnus-check-server
- (set (make-local-variable 'gnus-current-select-method)
- (gnus-find-method-for-group group)))
+ (setq-local gnus-current-select-method
+ (gnus-find-method-for-group group)))
(error "Couldn't open server"))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
@@ -6254,7 +6284,9 @@ If WHERE is `summary', the summary mode line format will be used."
mode-string (- max-len 3) nil nil t)))))
;; Update the mode line.
(setq mode-line-buffer-identification
- (gnus-mode-line-buffer-identification (list mode-string)))
+ (gnus-mode-line-buffer-identification
+ (list (propertize mode-string
+ 'face 'mode-line-buffer-id))))
(set-buffer-modified-p t))))
(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
@@ -10638,7 +10670,7 @@ groups."
(mime-to-mml current-handles))
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
- (set (make-local-variable 'mml-buffer-list) mbl1))
+ (setq-local mml-buffer-list mbl1))
(add-hook 'kill-buffer-hook #'mml-destroy-buffers t t))))
`(lambda (no-highlight)
(let ((mail-parse-charset ',gnus-newsgroup-charset)
@@ -12846,8 +12878,7 @@ UNREAD is a sorted list."
(and gnus-newsgroup-name
(gnus-parameter-charset gnus-newsgroup-name))
gnus-default-charset))
- (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
- ignored-charsets))))
+ (setq-local gnus-newsgroup-ignored-charsets ignored-charsets))))
;;;
;;; Mime Commands
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index c913002f70b..75de1e031c3 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1129,18 +1129,17 @@ articles in the topic and its subtopics."
(gnus-topic-make-menu-bar))
(gnus-set-format 'topic t)
(add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
- (set (make-local-variable 'gnus-group-prepare-function)
- 'gnus-group-prepare-topics)
- (set (make-local-variable 'gnus-group-get-parameter-function)
- 'gnus-group-topic-parameters)
- (set (make-local-variable 'gnus-group-goto-next-group-function)
- 'gnus-topic-goto-next-group)
- (set (make-local-variable 'gnus-group-indentation-function)
- 'gnus-topic-group-indentation)
- (set (make-local-variable 'gnus-group-update-group-function)
- 'gnus-topic-update-topics-containing-group)
- (set (make-local-variable 'gnus-group-sort-alist-function)
- 'gnus-group-sort-topic)
+ (setq-local gnus-group-prepare-function
+ 'gnus-group-prepare-topics)
+ (setq-local gnus-group-get-parameter-function
+ 'gnus-group-topic-parameters)
+ (setq-local gnus-group-goto-next-group-function
+ 'gnus-topic-goto-next-group)
+ (setq-local gnus-group-indentation-function
+ 'gnus-topic-group-indentation)
+ (setq-local gnus-group-update-group-function
+ 'gnus-topic-update-topics-containing-group)
+ (setq-local gnus-group-sort-alist-function 'gnus-group-sort-topic)
(setq gnus-group-change-level-function 'gnus-topic-change-level)
(setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
(add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index 3f2b5768db2..a852f20109e 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -100,8 +100,8 @@
\\{gnus-undo-mode-map}"
:keymap gnus-undo-mode-map
- (set (make-local-variable 'gnus-undo-actions) nil)
- (set (make-local-variable 'gnus-undo-boundary) t)
+ (setq-local gnus-undo-actions nil)
+ (setq-local gnus-undo-boundary t)
(when gnus-undo-mode
;; Set up the menu.
(when (gnus-visual-p 'undo-menu 'menu)
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index baa3146e64e..e900e294c57 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -68,7 +68,7 @@ used to display Gnus windows."
:type 'boolean)
(defvar gnus-buffer-configuration
- '((group
+ `((group
(vertical 1.0
(group 1.0 point)))
(summary
@@ -142,7 +142,7 @@ used to display Gnus windows."
(pipe
(vertical 1.0
(summary 0.25 point)
- (shell-command-buffer-name 1.0)))
+ (,shell-command-buffer-name 1.0)))
(bug
(vertical 1.0
(if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index c1cfddc87b3..abe7b1ae76a 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -309,34 +309,29 @@ be set in `.emacs' instead."
:group 'gnus-start
:type 'boolean)
-(defvar gnus-mode-line-image-cache t)
-
-(eval-and-compile
- (if (fboundp 'find-image)
- (defun gnus-mode-line-buffer-identification (line)
- (let ((str (car-safe line))
- (load-path (append (mm-image-load-path) load-path)))
- (if (and (display-graphic-p)
- (stringp str)
- (string-match "^Gnus:" str))
- (progn (add-text-properties
- 0 5
- (list 'display
- (if (eq t gnus-mode-line-image-cache)
- (setq gnus-mode-line-image-cache
- (find-image
- '((:type xpm :file "gnus-pointer.xpm"
- :ascent center)
- (:type xbm :file "gnus-pointer.xbm"
- :ascent center))))
- gnus-mode-line-image-cache)
- 'help-echo (format
- "This is %s, %s."
- gnus-version (gnus-emacs-version)))
- str)
- (list str))
- line)))
- (defalias 'gnus-mode-line-buffer-identification 'identity)))
+(defun gnus-mode-line-buffer-identification (line)
+ (let ((str (car-safe line)))
+ (if (or (not (fboundp 'find-image))
+ (not (display-graphic-p))
+ (not (stringp str))
+ (not (string-match "^Gnus:" str)))
+ line
+ (let ((load-path (append (mm-image-load-path) load-path)))
+ ;; Add the Gnus logo.
+ (add-text-properties
+ 0 5
+ (list 'display
+ (find-image
+ '((:type xpm :file "gnus-pointer.xpm"
+ :ascent center)
+ (:type xbm :file "gnus-pointer.xbm"
+ :ascent center))
+ t)
+ 'help-echo (format
+ "This is %s, %s."
+ gnus-version (gnus-emacs-version)))
+ str)
+ (list str)))))
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
@@ -3175,8 +3170,7 @@ that that variable is buffer-local to the summary buffers."
"Make mode lines a bit simpler."
(setq mode-line-modified "--")
(when (listp mode-line-format)
- (make-local-variable 'mode-line-format)
- (setq mode-line-format (copy-sequence mode-line-format))
+ (setq-local mode-line-format (copy-sequence mode-line-format))
(when (equal (nth 3 mode-line-format) " ")
(setcar (nthcdr 3 mode-line-format) " "))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 2ab3eb62120..b6c1c0b0713 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1155,7 +1155,7 @@ Note: Many newsgroups frown upon nontraditional reply styles.
You probably want to set this variable only for specific groups,
e.g. using `gnus-posting-styles':
- (eval (set (make-local-variable \\='message-cite-reply-position) \\='above))"
+ (eval (setq-local message-cite-reply-position \\='above))"
:version "24.1"
:type '(choice (const :tag "Reply inline" traditional)
(const :tag "Reply above" above)
@@ -1172,7 +1172,7 @@ Presets to impersonate popular mail agents are found in the
message-cite-style-* variables. This variable is intended for
use in `gnus-posting-styles', such as:
- ((posting-from-work-p) (eval (set (make-local-variable \\='message-cite-style) message-cite-style-outlook)))"
+ ((posting-from-work-p) (eval (setq-local message-cite-style message-cite-style-outlook)))"
:version "24.1"
:group 'message-insertion
:type '(choice (const :tag "Do not override variables" :value nil)
@@ -3078,44 +3078,43 @@ See also `message-forbidden-properties'."
Like `text-mode', but with these additional commands:
\\{message-mode-map}"
- (set (make-local-variable 'message-reply-buffer) nil)
- (set (make-local-variable 'message-inserted-headers) nil)
- (set (make-local-variable 'message-send-actions) nil)
- (set (make-local-variable 'message-return-action) nil)
- (set (make-local-variable 'message-exit-actions) nil)
- (set (make-local-variable 'message-kill-actions) nil)
- (set (make-local-variable 'message-postpone-actions) nil)
- (set (make-local-variable 'message-draft-article) nil)
+ (setq-local message-reply-buffer nil)
+ (setq-local message-inserted-headers nil)
+ (setq-local message-send-actions nil)
+ (setq-local message-return-action nil)
+ (setq-local message-exit-actions nil)
+ (setq-local message-kill-actions nil)
+ (setq-local message-postpone-actions nil)
+ (setq-local message-draft-article nil)
(setq buffer-offer-save t)
- (set (make-local-variable 'facemenu-add-face-function)
+ (setq-local facemenu-add-face-function
(lambda (face end)
(let ((face-fun (cdr (assq face message-face-alist))))
(if face-fun
(funcall face-fun (point) end)
(error "Face %s not configured for %s mode" face mode-name)))
""))
- (set (make-local-variable 'facemenu-remove-face-function) t)
- (set (make-local-variable 'message-reply-headers) nil)
+ (setq-local facemenu-remove-face-function t)
+ (setq-local message-reply-headers nil)
(make-local-variable 'message-newsreader)
(make-local-variable 'message-mailer)
(make-local-variable 'message-post-method)
- (set (make-local-variable 'message-sent-message-via) nil)
- (set (make-local-variable 'message-checksum) nil)
- (set (make-local-variable 'message-mime-part) 0)
+ (setq-local message-sent-message-via nil)
+ (setq-local message-checksum nil)
+ (setq-local message-mime-part 0)
(message-setup-fill-variables)
(when message-fill-column
(setq fill-column message-fill-column)
(turn-on-auto-fill))
;; Allow using comment commands to add/remove quoting.
- ;; (set (make-local-variable 'comment-start) message-yank-prefix)
+ ;; (setq-local comment-start message-yank-prefix)
(when message-yank-prefix
- (set (make-local-variable 'comment-start) message-yank-prefix)
- (set (make-local-variable 'comment-start-skip)
- (concat "^" (regexp-quote message-yank-prefix) "[ \t]*")))
- (set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t))
+ (setq-local comment-start message-yank-prefix)
+ (setq-local comment-start-skip
+ (concat "^" (regexp-quote message-yank-prefix) "[ \t]*")))
+ (setq-local font-lock-defaults '(message-font-lock-keywords t))
(if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) (message-make-tool-bar)))
+ (setq-local tool-bar-map (message-make-tool-bar)))
;; Mmmm... Forbidden properties...
(add-hook 'after-change-functions #'message-strip-forbidden-properties
nil 'local)
@@ -3134,45 +3133,41 @@ Like `text-mode', but with these additional commands:
;; Don't enable multibyte on an indirect buffer. Maybe enabling
;; multibyte is not necessary at all. -- zsh
(mm-enable-multibyte))
- (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.
+ (setq-local indent-tabs-mode nil) ; No tabs for indentation.
(mml-mode)
;; Syntactic fontification. Helps `show-paren-mode',
;; `electric-pair-mode', and C-M-* navigation by syntactically
;; excluding citations and other artifacts.
;;
- (set (make-local-variable 'syntax-propertize-function) 'message--syntax-propertize)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (setq-local syntax-propertize-function 'message--syntax-propertize)
+ (setq-local parse-sexp-ignore-comments t)
(setq-local message-encoded-mail-cache nil))
(defun message-setup-fill-variables ()
"Setup message fill variables."
- (set (make-local-variable 'fill-paragraph-function)
- 'message-fill-paragraph)
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
- (make-local-variable 'adaptive-fill-regexp)
+ (setq-local fill-paragraph-function 'message-fill-paragraph)
(make-local-variable 'adaptive-fill-first-line-regexp)
(let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if
;; message-yank-prefix is set to an abnormal value.
(concat "\\(" message-cite-prefix-regexp "\\)[ \t]*")))
- (setq paragraph-start
- (concat
- (regexp-quote mail-header-separator) "$\\|"
- "[ \t]*$\\|" ; blank lines
- "-- $\\|" ; signature delimiter
- "---+$\\|" ; delimiters for forwarded messages
- page-delimiter "$\\|" ; spoiler warnings
- ".*wrote:$\\|" ; attribution lines
- quote-prefix-regexp "$\\|" ; empty lines in quoted text
- ; mml tags
- "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
- (setq paragraph-separate paragraph-start)
- (setq adaptive-fill-regexp
- (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
- (setq adaptive-fill-first-line-regexp
- (concat quote-prefix-regexp "\\|"
- adaptive-fill-first-line-regexp)))
+ (setq-local paragraph-start
+ (concat
+ (regexp-quote mail-header-separator) "$\\|"
+ "[ \t]*$\\|" ; blank lines
+ "-- $\\|" ; signature delimiter
+ "---+$\\|" ; delimiters for forwarded messages
+ page-delimiter "$\\|" ; spoiler warnings
+ ".*wrote:$\\|" ; attribution lines
+ quote-prefix-regexp "$\\|" ; empty lines in quoted text
+ ; mml tags
+ "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local adaptive-fill-regexp
+ (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
+ (setq-local adaptive-fill-first-line-regexp
+ (concat quote-prefix-regexp "\\|"
+ adaptive-fill-first-line-regexp)))
(setq-local auto-fill-inhibit-regexp nil)
(setq-local normal-auto-fill-function 'message-do-auto-fill))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index ca610010917..015bc79f455 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -486,7 +486,7 @@ If MODE is not set, try to find mode automatically."
;; support modes, but now that we use font-lock-ensure, support modes
;; aren't a problem any more. So we could probably get rid of this
;; setting now, but it seems harmless and potentially still useful.
- (set (make-local-variable 'font-lock-mode-hook) nil)
+ (setq-local font-lock-mode-hook nil)
(setq buffer-file-name (mm-handle-filename handle))
(with-demoted-errors
(if mode
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 067396fc2a6..47dcb54562c 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1266,8 +1266,8 @@ See Info node `(emacs-mime)Composing'.
:lighter " MML" :keymap mml-mode-map
(when mml-mode
(when (boundp 'dnd-protocol-alist)
- (set (make-local-variable 'dnd-protocol-alist)
- (append mml-dnd-protocol-alist dnd-protocol-alist)))))
+ (setq-local dnd-protocol-alist
+ (append mml-dnd-protocol-alist dnd-protocol-alist)))))
;;;
;;; Helper functions for reading MIME stuff from the minibuffer and
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index ccd17744993..ef520704123 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1002,10 +1002,10 @@ all. This may very well take some time.")
(let ((buffer (gnus-get-buffer-create
(format " *nndiary overview %s*" group))))
(with-current-buffer buffer
- (set (make-local-variable 'nndiary-nov-buffer-file-name)
- (expand-file-name
- nndiary-nov-file-name
- (nnmail-group-pathname group nndiary-directory)))
+ (setq-local nndiary-nov-buffer-file-name
+ (expand-file-name
+ nndiary-nov-file-name
+ (nnmail-group-pathname group nndiary-directory)))
(erase-buffer)
(when (file-exists-p nndiary-nov-buffer-file-name)
(nnheader-insert-file-contents nndiary-nov-buffer-file-name)))
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 6ff99056d84..b7bfd9afd05 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -1083,7 +1083,7 @@ This command does not work if you use short group names."
(let ((coding-system-for-write
(or nnfolder-file-coding-system-for-write
nnfolder-file-coding-system)))
- (set (make-local-variable 'copyright-update) nil)
+ (setq-local copyright-update nil)
(save-buffer)))
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
(nnfolder-save-nov))))
@@ -1098,8 +1098,8 @@ This command does not work if you use short group names."
(or (cdr (assoc group nnfolder-nov-buffer-alist))
(let ((buffer (gnus-get-buffer-create (format " *nnfolder overview %s*" group))))
(with-current-buffer buffer
- (set (make-local-variable 'nnfolder-nov-buffer-file-name)
- (nnfolder-group-nov-pathname group))
+ (setq-local nnfolder-nov-buffer-file-name
+ (nnfolder-group-nov-pathname group))
(erase-buffer)
(when (file-exists-p nnfolder-nov-buffer-file-name)
(nnheader-insert-file-contents nnfolder-nov-buffer-file-name)))
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 2952e20928b..c97622114dc 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -568,7 +568,7 @@ the line could be found."
(mm-enable-multibyte)
(kill-all-local-variables)
(setq case-fold-search t) ;Should ignore case.
- (set (make-local-variable 'nntp-process-response) nil)
+ (setq-local nntp-process-response nil)
t))
;;; Various functions the backends use.
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index a8603330662..61693a08b98 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -157,6 +157,9 @@ during splitting, which may be slow."
:version "28.1"
:type 'boolean)
+(defvar nnimap--split-download-body nil
+ "Like `nnimap-split-download-body', but for internal use.")
+
(defvar nnimap-process nil)
(defvar nnimap-status-string "")
@@ -373,10 +376,10 @@ during splitting, which may be slow."
(mm-disable-multibyte)
(buffer-disable-undo)
(gnus-add-buffer)
- (set (make-local-variable 'after-change-functions) nil) ;FIXME: Why?
- (set (make-local-variable 'nnimap-object)
- (make-nnimap :server (nnoo-current-server 'nnimap)
- :initial-resync 0))
+ (setq-local after-change-functions nil) ;FIXME: Why?
+ (setq-local nnimap-object
+ (make-nnimap :server (nnoo-current-server 'nnimap)
+ :initial-resync 0))
(push (list buffer (current-buffer)) nnimap-connection-alist)
(push (current-buffer) nnimap-process-buffers)
(current-buffer)))
@@ -2108,7 +2111,8 @@ Return the server's response to the SELECT or EXAMINE command."
"BODY.PEEK"
"RFC822.PEEK"))
(cond
- (nnimap-split-download-body
+ ((or nnimap-split-download-body
+ nnimap--split-download-body)
"[]")
((nnimap-ver4-p)
"[HEADER]")
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index ad608b6575e..c648e3aae7c 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -778,8 +778,8 @@ article number. This function is called narrowed to an article."
group)))
(file-name-coding-system nnmail-pathname-coding-system))
(with-current-buffer buffer
- (set (make-local-variable 'nnml-nov-buffer-file-name)
- (nnmail-group-pathname group nnml-directory nnml-nov-file-name))
+ (setq-local nnml-nov-buffer-file-name
+ (nnmail-group-pathname group nnml-directory nnml-nov-file-name))
(erase-buffer)
(when (and (not incrementalp)
(file-exists-p nnml-nov-buffer-file-name))
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 96a7da2313c..e74aef3efe6 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -44,12 +44,9 @@
;;; for the definitions of group content classification and spam processors
(require 'gnus)
-(eval-when-compile (require 'hashcash))
-
-;; for nnimap-split-download-body-default
-(eval-when-compile (require 'nnimap))
-
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'hashcash))
;; autoload query-dig
(autoload 'query-dig "dig")
@@ -1228,10 +1225,20 @@ Will not return a nil score."
;;{{{ set up widening, processor checks
-;;; set up IMAP widening if it's necessary
+(defconst spam--widened (list ())
+ "Unique value identifying changes to `nnimap--split-download-body'.")
+
(defun spam-setup-widening ()
- (when (spam-widening-needed-p)
- (setq nnimap-split-download-body-default t)))
+ "Set up IMAP widening if it's necessary."
+ (and (boundp 'nnimap--split-download-body)
+ (not nnimap--split-download-body)
+ (spam-widening-needed-p)
+ (setq nnimap--split-download-body spam--widened)))
+
+(defun spam-teardown-widening ()
+ "Tear down IMAP widening."
+ (when (eq (bound-and-true-p nnimap--split-download-body) spam--widened)
+ (setq nnimap--split-download-body nil)))
(defun spam-widening-needed-p (&optional force-symbols)
(let (found)
@@ -2865,6 +2872,7 @@ installed through `spam-necessary-extra-headers'."
(defun spam-unload-hook ()
"Uninstall the spam.el hooks."
(interactive)
+ (spam-teardown-widening)
(remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
(remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
(remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 1c55d0ed79a..043c79f3900 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1137,8 +1137,7 @@ it is displayed along with the global value."
(when (looking-at "value is") (replace-match ""))
(save-excursion
(insert "\n\nValue:")
- (set (make-local-variable 'help-button-cache)
- (point-marker)))
+ (setq-local help-button-cache (point-marker)))
(insert "value is shown ")
(insert-button "below"
'action help-button-cache
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 732e6cc28dd..025a67016b6 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -319,10 +319,10 @@ The format is (FUNCTION ARGS...).")
Entry to this mode runs the normal hook `help-mode-hook'.
Commands:
\\{help-mode-map}"
- (set (make-local-variable 'revert-buffer-function)
- 'help-mode-revert-buffer)
- (set (make-local-variable 'bookmark-make-record-function)
- 'help-bookmark-make-record))
+ (setq-local revert-buffer-function
+ #'help-mode-revert-buffer)
+ (setq-local bookmark-make-record-function
+ #'help-bookmark-make-record))
;;;###autoload
(defun help-mode-setup ()
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 5d813c410c2..1fe9aad66de 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -722,7 +722,10 @@ With prefix arg N, puts point N bytes of the way from the true beginning."
"Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
(interactive "P")
(setq arg (if (null arg)
- (1- (window-height))
+ (- (window-height)
+ 1
+ (if ruler-mode 1 0)
+ next-screen-context-lines)
(prefix-numeric-value arg)))
(hexl-scroll-up (- arg)))
@@ -731,7 +734,10 @@ With prefix arg N, puts point N bytes of the way from the true beginning."
If there's no byte at the target address, move to the first or last line."
(interactive "P")
(setq arg (if (null arg)
- (1- (window-height))
+ (- (window-height)
+ 1
+ (if ruler-mode 1 0)
+ next-screen-context-lines)
(prefix-numeric-value arg)))
(let* ((movement (* arg 16))
(address (hexl-current-address))
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 00ba868d78f..7269af3fe04 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -2464,7 +2464,7 @@ FORMATS is the value to use for `ibuffer-formats'.
(require 'ibuf-ext)
(setq ibuffer-filter-groups filter-groups))
(when formats
- (set (make-local-variable 'ibuffer-formats) formats))
+ (setq-local ibuffer-formats formats))
(ibuffer-update nil)
;; Skip the group name by default.
(ibuffer-forward-line 0 t)
@@ -2683,7 +2683,7 @@ You may rearrange filter groups by using the usual pair
`\\[ibuffer-kill-line]' and `\\[ibuffer-yank]'. Yanked groups
will be inserted before the group at point."
;; Include state info next to the mode name.
- (set (make-local-variable 'mode-line-process)
+ (setq-local mode-line-process
'(" by "
(ibuffer-sorting-mode (:eval (symbol-name ibuffer-sorting-mode))
"view time")
@@ -2712,28 +2712,27 @@ will be inserted before the group at point."
(setq show-trailing-whitespace nil)
;; disable `show-paren-mode' buffer-locally
(if (bound-and-true-p show-paren-mode)
- (set (make-local-variable 'show-paren-mode) nil))
- (set (make-local-variable 'revert-buffer-function)
- #'ibuffer-update)
- (set (make-local-variable 'ibuffer-sorting-mode)
- ibuffer-default-sorting-mode)
- (set (make-local-variable 'ibuffer-sorting-reversep)
- ibuffer-default-sorting-reversep)
- (set (make-local-variable 'ibuffer-shrink-to-minimum-size)
- ibuffer-default-shrink-to-minimum-size)
- (set (make-local-variable 'ibuffer-display-maybe-show-predicates)
- ibuffer-default-display-maybe-show-predicates)
- (set (make-local-variable 'ibuffer-filtering-qualifiers) nil)
- (set (make-local-variable 'ibuffer-filter-groups) nil)
- (set (make-local-variable 'ibuffer-filter-group-kill-ring) nil)
- (set (make-local-variable 'ibuffer-hidden-filter-groups) nil)
- (set (make-local-variable 'ibuffer-compiled-formats) nil)
- (set (make-local-variable 'ibuffer-cached-formats) nil)
- (set (make-local-variable 'ibuffer-cached-eliding-string) nil)
- (set (make-local-variable 'ibuffer-current-format) nil)
- (set (make-local-variable 'ibuffer-did-modification) nil)
- (set (make-local-variable 'ibuffer-tmp-hide-regexps) nil)
- (set (make-local-variable 'ibuffer-tmp-show-regexps) nil)
+ (setq-local show-paren-mode nil))
+ (setq-local revert-buffer-function #'ibuffer-update)
+ (setq-local ibuffer-sorting-mode
+ ibuffer-default-sorting-mode)
+ (setq-local ibuffer-sorting-reversep
+ ibuffer-default-sorting-reversep)
+ (setq-local ibuffer-shrink-to-minimum-size
+ ibuffer-default-shrink-to-minimum-size)
+ (setq-local ibuffer-display-maybe-show-predicates
+ ibuffer-default-display-maybe-show-predicates)
+ (setq-local ibuffer-filtering-qualifiers nil)
+ (setq-local ibuffer-filter-groups nil)
+ (setq-local ibuffer-filter-group-kill-ring nil)
+ (setq-local ibuffer-hidden-filter-groups nil)
+ (setq-local ibuffer-compiled-formats nil)
+ (setq-local ibuffer-cached-formats nil)
+ (setq-local ibuffer-cached-eliding-string nil)
+ (setq-local ibuffer-current-format nil)
+ (setq-local ibuffer-did-modification nil)
+ (setq-local ibuffer-tmp-hide-regexps nil)
+ (setq-local ibuffer-tmp-show-regexps nil)
(define-key ibuffer-mode-map [menu-bar edit] 'undefined)
(define-key ibuffer-mode-map [menu-bar operate] (cons "Operate" ibuffer-mode-operate-map))
(ibuffer-update-format)
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 9c1470812ab..0fdacd0a3c6 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -75,12 +75,7 @@ everything preceding the ~/ is discarded so the interactive
selection process starts again from the user's $HOME.")
(defcustom icomplete-show-matches-on-no-input nil
- "If nil, don't wait for completions before showing the prompt.
-Instead, when there's no input, completions may be displayed
-asynchronously later, when the completions have been computed.
-
-If non-nil, always compute the completions first.
-
+ "When non-nil, show completions when the minibuffer is empty.
This also means that if you traverse the list of completions with
commands like `C-.' and just hit RET without typing any
characters, the match under point will be chosen instead of the
@@ -446,7 +441,7 @@ Conditions are:
"Run in minibuffer on activation to establish incremental completion.
Usually run by inclusion in `minibuffer-setup-hook'."
(when (and icomplete-mode (icomplete-simple-completing-p))
- (set (make-local-variable 'completion-show-inline-help) nil)
+ (setq-local completion-show-inline-help nil)
(use-local-map (make-composed-keymap icomplete-minibuffer-map
(current-local-map)))
(add-hook 'pre-command-hook #'icomplete-pre-command-hook nil t)
@@ -469,7 +464,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(when (and completion-in-region-mode
icomplete-mode (icomplete-simple-completing-p))
(setq icomplete--in-region-buffer (current-buffer))
- (set (make-local-variable 'completion-show-inline-help) nil)
+ (setq-local completion-show-inline-help nil)
(let ((tem (assq 'completion-in-region-mode
minor-mode-overriding-map-alist)))
(unless (memq icomplete-minibuffer-map (cdr tem))
diff --git a/lisp/ido.el b/lisp/ido.el
index c83b700e656..5758d3fdeac 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."
(boundp 'ido-completion-buffer-full))
(set-window-start win (point-min))
(with-no-warnings
- (set (make-local-variable 'ido-completion-buffer-full) t))
+ (setq-local ido-completion-buffer-full t))
(setq full-list t
display-it t))
(scroll-other-window))
@@ -4810,8 +4810,7 @@ Modified from `icomplete-completions'."
(delete-region ido-eoinput (point-max))))
;; Reestablish the local variable 'cause minibuffer-setup is weird:
- (make-local-variable 'ido-eoinput)
- (setq ido-eoinput 1))))
+ (setq-local ido-eoinput 1))))
(defun ido-summary-buffers-to-end ()
;; Move the summaries to the end of the buffer list.
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 91d025dd5dd..b958389ea57 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -529,8 +529,8 @@ Customized bindings may be defined in `ielm-map', which currently contains:
:syntax-table emacs-lisp-mode-syntax-table
(setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt)))
- (set (make-local-variable 'paragraph-separate) "\\'")
- (set (make-local-variable 'paragraph-start) comint-prompt-regexp)
+ (setq-local paragraph-separate "\\'")
+ (setq-local paragraph-start comint-prompt-regexp)
(setq comint-input-sender 'ielm-input-sender)
(setq comint-process-echoes nil)
(dolist (f '(elisp-completion-at-point
@@ -541,28 +541,28 @@ Customized bindings may be defined in `ielm-map', which currently contains:
#'elisp-eldoc-var-docstring nil t)
(add-hook 'eldoc-documentation-functions
#'elisp-eldoc-funcall nil t)
- (set (make-local-variable 'ielm-prompt-internal) ielm-prompt)
- (set (make-local-variable 'comint-prompt-read-only) ielm-prompt-read-only)
+ (setq-local ielm-prompt-internal ielm-prompt)
+ (setq-local comint-prompt-read-only ielm-prompt-read-only)
(setq comint-get-old-input 'ielm-get-old-input)
- (set (make-local-variable 'comint-completion-addsuffix) '("/" . ""))
+ (setq-local comint-completion-addsuffix '("/" . ""))
(setq mode-line-process '(":%s on " (:eval (buffer-name ielm-working-buffer))))
;; Useful for `hs-minor-mode'.
(setq-local comment-start ";")
(setq-local comment-use-syntax t)
(setq-local lexical-binding t)
- (set (make-local-variable 'indent-line-function) #'ielm-indent-line)
- (set (make-local-variable 'ielm-working-buffer) (current-buffer))
- (set (make-local-variable 'fill-paragraph-function) #'lisp-fill-paragraph)
+ (setq-local indent-line-function #'ielm-indent-line)
+ (setq-local ielm-working-buffer (current-buffer))
+ (setq-local fill-paragraph-function #'lisp-fill-paragraph)
;; Value holders
- (set (make-local-variable '*) nil)
- (set (make-local-variable '**) nil)
- (set (make-local-variable '***) nil)
- (set (make-local-variable 'ielm-match-data) nil)
+ (setq-local * nil)
+ (setq-local ** nil)
+ (setq-local *** nil)
+ (setq-local ielm-match-data nil)
;; font-lock support
- (set (make-local-variable 'font-lock-defaults)
+ (setq-local font-lock-defaults
'(ielm-font-lock-keywords nil nil ((?: . "w") (?- . "w") (?* . "w"))))
;; A dummy process to keep comint happy. It will never get any input
@@ -577,7 +577,7 @@ Customized bindings may be defined in `ielm-map', which currently contains:
;; Lisp output can include raw characters that confuse comint's
;; carriage control code.
- (set (make-local-variable 'comint-inhibit-carriage-motion) t)
+ (setq-local comint-inhibit-carriage-motion t)
;; Add a silly header
(insert ielm-header)
diff --git a/lisp/image.el b/lisp/image.el
index 9ebb603086e..023d64fc4ee 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -679,8 +679,10 @@ BUFFER nil or omitted means use the current buffer."
(setq path (cdr path)))
(if found filename)))
+(defvar find-image--cache (make-hash-table :test #'equal))
+
;;;###autoload
-(defun find-image (specs)
+(defun find-image (specs &optional cache)
"Find an image, choosing one of a list of image specifications.
SPECS is a list of image specifications.
@@ -695,26 +697,33 @@ is supported, and FILE exists, is used to construct the image
specification to be returned. Return nil if no specification is
satisfied.
+If CACHE is non-nil, results are cached and returned on subsequent calls.
+
The image is looked for in `image-load-path'.
Image files should not be larger than specified by `max-image-size'."
- (let (image)
- (while (and specs (null image))
- (let* ((spec (car specs))
- (type (plist-get spec :type))
- (data (plist-get spec :data))
- (file (plist-get spec :file))
- found)
- (when (image-type-available-p type)
- (cond ((stringp file)
- (if (setq found (image-search-load-path file))
- (setq image
- (cons 'image (plist-put (copy-sequence spec)
- :file found)))))
- ((not (null data))
- (setq image (cons 'image spec)))))
- (setq specs (cdr specs))))
- image))
+ (or (and cache
+ (gethash specs find-image--cache))
+ (let ((orig-specs specs)
+ image)
+ (while (and specs (null image))
+ (let* ((spec (car specs))
+ (type (plist-get spec :type))
+ (data (plist-get spec :data))
+ (file (plist-get spec :file))
+ found)
+ (when (image-type-available-p type)
+ (cond ((stringp file)
+ (if (setq found (image-search-load-path file))
+ (setq image
+ (cons 'image (plist-put (copy-sequence spec)
+ :file found)))))
+ ((not (null data))
+ (setq image (cons 'image spec)))))
+ (setq specs (cdr specs))))
+ (when cache
+ (setf (gethash orig-specs find-image--cache) image))
+ image)))
;;;###autoload
diff --git a/lisp/image/exif.el b/lisp/image/exif.el
index 6aeb52c726d..e328fcce5a8 100644
--- a/lisp/image/exif.el
+++ b/lisp/image/exif.el
@@ -165,7 +165,7 @@ If the orientation isn't present in the data, return nil."
;; Another magical number.
(unless (= (exif--read-number 2 le) #x002a)
(signal 'exif-error "Invalid TIFF header length"))
- (let ((offset (exif--read-number 2 le)))
+ (let ((offset (exif--read-number 4 le)))
;; Jump to where the IFD (directory) starts and parse it.
(when (> (1+ offset) (point-max))
(signal 'exif-error "Invalid IFD (directory) offset"))
diff --git a/lisp/info.el b/lisp/info.el
index c3684deb96b..c049aa88a5d 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2473,7 +2473,7 @@ Table of contents is created from the tree structure of menus."
(setq bound (or (and (equal nodename "Top")
(save-excursion
(re-search-forward
- "^[ \t-]*The Detailed Node Listing" nil t)))
+ "^[ \t—-]*The Detailed Node Listing" nil t)))
bound))
(while (< (point) bound)
(cond
@@ -4790,10 +4790,10 @@ first line or header line, and for breadcrumb links.")
;; an end of sentence
(skip-syntax-backward " ("))
(setq other-tag
- (cond ((save-match-data (looking-back "\\ ")
(push (rmail-epa-decrypt-1 mime) decrypts))))
- (when (and decrypts (eq major-mode 'rmail-mode))
- (rmail-add-label "decrypt"))
-
(when (and decrypts (rmail-buffers-swapped-p))
(when (y-or-n-p "Replace the original message? ")
+ (when (eq major-mode 'rmail-mode)
+ (rmail-add-label "decrypt"))
(setq decrypts (nreverse decrypts))
(let ((beg (rmail-msgbeg rmail-current-message))
(end (rmail-msgend rmail-current-message)))
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index a085e0bc4ff..9ccc0cfee97 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -121,6 +121,7 @@ Setting this option to nil might speed up the generation of summaries."
(define-key map [?\S-\ ] 'rmail-summary-scroll-msg-down)
(define-key map "\177" 'rmail-summary-scroll-msg-down)
(define-key map "?" 'describe-mode)
+ (define-key map "\C-c\C-d" 'rmail-summary-epa-decrypt)
(define-key map "\C-c\C-n" 'rmail-summary-next-same-subject)
(define-key map "\C-c\C-p" 'rmail-summary-previous-same-subject)
(define-key map "\C-c\C-s\C-d" 'rmail-summary-sort-by-date)
@@ -1482,6 +1483,12 @@ argument says to read a file name and use that file as the inbox."
(rmail-edit-current-message)
(use-local-map rmail-summary-edit-map))
+(defun rmail-summary-epa-decrypt ()
+ "Decrypt this message."
+ (interactive)
+ (rmail-pop-to-buffer rmail-buffer)
+ (rmail-epa-decrypt))
+
(defun rmail-summary-cease-edit ()
"Finish editing message, then go back to Rmail summary buffer."
(interactive)
diff --git a/lisp/man.el b/lisp/man.el
index 991b1bb60e5..8430201c562 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1583,10 +1583,10 @@ The following key bindings are currently in effect in the buffer:
(auto-fill-mode -1)
(setq imenu-generic-expression (list (list nil Man-heading-regexp 0)))
(imenu-add-to-menubar man-imenu-title)
- (set (make-local-variable 'outline-regexp) Man-heading-regexp)
- (set (make-local-variable 'outline-level) (lambda () 1))
- (set (make-local-variable 'bookmark-make-record-function)
- 'Man-bookmark-make-record)
+ (setq-local outline-regexp Man-heading-regexp)
+ (setq-local outline-level (lambda () 1))
+ (setq-local bookmark-make-record-function
+ #'Man-bookmark-make-record)
(add-hook 'window-state-change-functions #'Man--window-state-change nil t))
(defun Man-build-section-list ()
diff --git a/lisp/master.el b/lisp/master.el
index 32556a535f3..88baa1f8218 100644
--- a/lisp/master.el
+++ b/lisp/master.el
@@ -96,8 +96,7 @@ yourself the value of `master-of' by calling `master-show-slave'."
"Makes BUFFER the slave of the current buffer.
Use \\[master-mode] to toggle control of the slave buffer."
(interactive "bSlave: ")
- (make-local-variable 'master-of)
- (setq master-of buffer)
+ (setq-local master-of buffer)
(run-hooks 'master-set-slave-hook))
(defun master-show-slave ()
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index d44d8968221..456193d52e1 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2067,14 +2067,14 @@ variables.")
(funcall aff-fun completions)))
(with-current-buffer standard-output
- (set (make-local-variable 'completion-base-position)
+ (setq-local completion-base-position
(list (+ start base-size)
;; FIXME: We should pay attention to completion
;; boundaries here, but currently
;; completion-all-completions does not give us the
;; necessary information.
end))
- (set (make-local-variable 'completion-list-insert-choice-function)
+ (setq-local completion-list-insert-choice-function
(let ((ctable minibuffer-completion-table)
(cpred minibuffer-completion-predicate)
(cprops completion-extra-properties))
@@ -2866,7 +2866,7 @@ See `read-file-name' for the meaning of the arguments."
;; On the first request on `M-n' fill
;; `minibuffer-default' with a list of defaults
;; relevant for file-name reading.
- (set (make-local-variable 'minibuffer-default-add-function)
+ (setq-local minibuffer-default-add-function
(lambda ()
(with-current-buffer
(window-buffer (minibuffer-selected-window))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 63e6eedb200..c4b68f1be4e 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -416,6 +416,9 @@ will be killed."
(defvar rcirc-server-buffer nil
"The server buffer associated with this channel buffer.")
+(defvar rcirc-server-parameters nil
+ "List of parameters received from the server.")
+
(defvar rcirc-target nil
"The channel or user associated with this buffer.")
@@ -586,6 +589,7 @@ If ARG is non-nil, instead prompt for connection parameters."
(setq-local rcirc-user-disconnect nil)
(setq-local rcirc-user-authenticated nil)
(setq-local rcirc-connecting t)
+ (setq-local rcirc-server-parameters nil)
(add-hook 'auto-save-hook 'rcirc-log-write)
@@ -2873,9 +2877,28 @@ Not in rfc1459.txt"
(defun rcirc-handler-433 (process sender args text)
"ERR_NICKNAMEINUSE"
(rcirc-handler-generic process "433" sender args text)
- (let* ((new-nick (concat (cadr args) "`")))
- (with-rcirc-process-buffer process
- (rcirc-cmd-nick new-nick nil process))))
+ (with-rcirc-process-buffer process
+ (let* ((length (string-to-number
+ (or (rcirc-server-parameter-value 'nicklen)
+ "16"))))
+ (rcirc-cmd-nick (rcirc--make-new-nick (cadr args) length) nil process))))
+
+(defun rcirc--make-new-nick (nick length)
+ ;; If we already have some ` chars at the end, then shorten the
+ ;; non-` bit of the name.
+ (when (= (length nick) length)
+ (setq nick (replace-regexp-in-string "[^`]\\(`+\\)\\'" "\\1" nick)))
+ (concat
+ (if (>= (length nick) length)
+ (substring nick 0 (1- length))
+ nick)
+ "`"))
+
+(defun rcirc-handler-005 (process sender args text)
+ "ERR_NICKNAMEINUSE"
+ (rcirc-handler-generic process "005" sender args text)
+ (with-rcirc-process-buffer process
+ (setq rcirc-server-parameters (append rcirc-server-parameters args))))
(defun rcirc-authenticate ()
"Send authentication to process associated with current buffer.
@@ -3072,6 +3095,13 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(>= (point) rcirc-prompt-end-marker))
+(defun rcirc-server-parameter-value (parameter)
+ (cl-loop for elem in rcirc-server-parameters
+ for setting = (split-string elem "=")
+ when (and (= (length setting) 2)
+ (string-equal (downcase (car setting)) parameter))
+ return (cadr setting)))
+
(provide 'rcirc)
;;; rcirc.el ends here
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 9b22a5083fb..cb50a0adbea 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -260,7 +260,7 @@
(setq state (process-get proc 'socks-state))
(cond
((= state socks-state-waiting-for-auth)
- (cl-callf (lambda (s) (setq string (concat string s)))
+ (cl-callf (lambda (s) (setq string (concat s string)))
(process-get proc 'socks-scratch))
(if (< (length string) 2)
nil ; We need to spin some more
@@ -272,7 +272,7 @@
((= state socks-state-authenticated)
)
((= state socks-state-waiting)
- (cl-callf (lambda (s) (setq string (concat string s)))
+ (cl-callf (lambda (s) (setq string (concat s string)))
(process-get proc 'socks-scratch))
(setq version (process-get proc 'socks-server-protocol))
(cond
@@ -542,7 +542,7 @@
service))
(process-put proc 'socks-buffer buffer)
(process-put proc 'socks-host host)
- (process-put proc 'socks-service host)
+ (process-put proc 'socks-service service)
(set-process-filter proc nil)
(set-process-buffer proc (if buffer (get-buffer-create buffer)))
proc))))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 4947d161f3f..f6e89339b68 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -1260,6 +1260,9 @@ connection if a previous connection has died for some reason."
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
;; Change prompt.
(tramp-set-connection-property
p "prompt" (regexp-quote (format "///%s#$" prompt)))
@@ -1312,9 +1315,6 @@ connection if a previous connection has died for some reason."
(tramp-error
vec 'file-error "Cannot switch to user `%s'" user)))
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
;; Mark it as connected.
(tramp-set-connection-property p "connected" t)))))))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index f3d03d0fb0a..1722c53be05 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1434,6 +1434,9 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(unless (process-live-p p)
(tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ ;; Set "gio-file-monitor" property. We believe, that "gio
+ ;; monitor" uses polling when applied for mounted files.
+ (tramp-set-connection-property p "gio-file-monitor" 'GPollFileMonitor)
p))))
(defun tramp-gvfs-monitor-process-filter (proc string)
@@ -2112,7 +2115,10 @@ connection if a previous connection has died for some reason."
:buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t)))
(process-put p 'vector vec)
- (set-process-query-on-exit-flag p nil)))
+ (set-process-query-on-exit-flag p nil)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)))
(unless (tramp-gvfs-connection-mounted-p vec)
(let ((method (tramp-file-name-method vec))
@@ -2216,9 +2222,6 @@ connection if a previous connection has died for some reason."
(and (functionp tramp-password-save-function)
(funcall tramp-password-save-function)))
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
;; Mark it as connected.
(tramp-set-connection-property
(tramp-get-connection-process vec) "connected" t)))))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 1ce6542d1a7..98537a100f3 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -480,7 +480,7 @@ The string is used in `tramp-methods'.")
;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin
;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
-;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin
+;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin
;; IRIX64: /usr/bin
;; QNAP QTS: ---
;; Hydra: /run/current-system/sw/bin:/bin:/usr/bin
@@ -595,10 +595,12 @@ rm -f %t"
"Shell function to implement `uudecode' to standard output.
Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
for this or `uudecode -p', but some systems don't, and for them
-we have this shell function.")
+we have this shell function.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-file-truename
- "%s -e '
+ "%p -e '
use File::Spec;
use Cwd \"realpath\";
@@ -633,14 +635,14 @@ if (!$result) {
$result =~ s/\"/\\\\\"/g;
print \"\\\"$result\\\"\\n\";
-' \"$1\" 2>/dev/null"
+' \"$1\" %n"
"Perl script to produce output suitable for use with `file-truename'
on the remote file system.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-file-name-all-completions
- "%s -e '
+ "%p -e '
opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
@files = readdir(d); closedir(d);
foreach $f (@files) {
@@ -652,11 +654,11 @@ foreach $f (@files) {
}
}
print \"ok\\n\"
-' \"$1\" 2>/dev/null"
+' \"$1\" %n"
"Perl script to produce output suitable for use with
-`file-name-all-completions' on the remote file system. Escape
-sequence %s is replaced with name of Perl binary. This string is
-passed to `format', so percent characters need to be doubled.")
+`file-name-all-completions' on the remote file system.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
;; Perl script to implement `file-attributes' in a Lisp `read'able
;; output. If you are hacking on this, note that you get *no* output
@@ -665,7 +667,7 @@ passed to `format', so percent characters need to be doubled.")
;; The device number is returned as "-1", because there will be a virtual
;; device number set in `tramp-sh-handle-file-attributes'.
(defconst tramp-perl-file-attributes
- "%s -e '
+ "%p -e '
@stat = lstat($ARGV[0]);
if (!@stat) {
print \"nil\\n\";
@@ -702,14 +704,14 @@ printf(
$stat[7],
$stat[2],
$stat[1]
-);' \"$1\" \"$2\" 2>/dev/null"
+);' \"$1\" \"$2\" %n"
"Perl script to produce output suitable for use with `file-attributes'
on the remote file system.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-directory-files-and-attributes
- "%s -e '
+ "%p -e '
chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
@list = readdir(DIR);
@@ -754,31 +756,31 @@ for($i = 0; $i < $n; $i++)
$stat[2],
$stat[1]);
}
-printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
+printf(\")\\n\");' \"$1\" \"$2\" %n"
"Perl script implementing `directory-files-and-attributes' as Lisp `read'able
output.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
;; These two use base64 encoding.
(defconst tramp-perl-encode-with-module
- "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n"
+ "%p -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n"
"Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.
This implementation requires the MIME::Base64 Perl module to be installed
-on the remote host.")
+on the remote host.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-decode-with-module
- "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' %n"
+ "%p -MMIME::Base64 -0777 -ne 'print decode_base64($_)' %n"
"Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.
This implementation requires the MIME::Base64 Perl module to be installed
-on the remote host.")
+on the remote host.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-encode
- "%s -e '
+ "%p -e '
# This script contributed by Juanma Barranquero .
# Copyright (C) 2002-2020 Free Software Foundation, Inc.
use strict;
@@ -813,11 +815,11 @@ while (read STDIN, $data, 54) {
qq(\\n);
}' %n"
"Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-decode
- "%s -e '
+ "%p -e '
# This script contributed by Juanma Barranquero .
# Copyright (C) 2002-2020 Free Software Foundation, Inc.
use strict;
@@ -857,22 +859,25 @@ while (my $data = ) {
last if $finished;
}' %n"
"Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-pack
- "%s -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
+ "%p -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)' %n"
"Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-unpack
- "%s -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"
+ "%p -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)' %n"
"Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-hexdump-encode "%h -v -e '16/1 \" %%02x\" \"\\n\"'"
"`hexdump' program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-awk-encode
"%a '\\
@@ -906,21 +911,24 @@ END {
printf tail
}'"
"`awk' program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-hexdump-awk-encode
(format "%s | %s" tramp-hexdump-encode tramp-awk-encode)
"`hexdump' / `awk' pipe to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-od-encode "%o -v -t x1 -A n"
"`od' program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
-(defconst tramp-od-awk-encode
- (format "%s | %s" tramp-od-encode tramp-awk-encode)
+(defconst tramp-od-awk-encode (format "%s | %s" tramp-od-encode tramp-awk-encode)
"`od' / `awk' pipe to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-awk-decode
"%a '\\
@@ -946,7 +954,8 @@ BEGIN {
}
}'"
"Awk program to use for decoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-vc-registered-read-file-names
"echo \"(\"
@@ -968,7 +977,8 @@ echo \")\""
It must be send formatted with two strings; the tests for file
existence, and file readability. Input shall be read via
here-document, otherwise the command could exceed maximum length
-of command line.")
+of command line.
+Format specifiers \"%s\" are replaced before the script is used.")
;; New handlers should be added here.
;;;###tramp-autoload
@@ -3296,7 +3306,9 @@ implementation will be used."
;; correctly. Unset `file-name-handler-alist'.
;; Otherwise, epa-file gets confused.
(let (file-name-handler-alist
- (coding-system-for-write 'binary))
+ (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))
@@ -3822,6 +3834,10 @@ Fall back to normal file name handler if no Tramp handler exists."
(unless (process-live-p p)
(tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ ;; Set "gio-file-monitor" property if needed.
+ (when (string-equal (file-name-nondirectory command) "gio")
+ (tramp-set-connection-property
+ p "gio-file-monitor" (tramp-get-remote-gio-file-monitor v)))
p))))
(defun tramp-sh-gio-monitor-process-filter (proc string)
@@ -3994,6 +4010,51 @@ Fall back to normal file name handler if no Tramp handler exists."
;;; Internal Functions:
+(defun tramp-expand-script (vec script)
+ "Expand SCRIPT with remote files or commands.
+\"%a\", \"%h\", \"%o\" and \"%p\" format specifiers are replaced
+by the respective `awk', `hexdump', `od' and `perl' commands.
+\"%n\" is replaced 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 "\\(^\\|[^%]\\)%[ahnopt]" script))
+ script
+ (catch 'wont-work
+ (let ((awk (when (string-match-p "\\(^\\|[^%]\\)%a" script)
+ (or
+ (if vec (tramp-get-remote-awk vec) (executable-find "awk"))
+ (throw 'wont-work nil))))
+ (hdmp (when (string-match-p "\\(^\\|[^%]\\)%h" script)
+ (or
+ (if vec (tramp-get-remote-hexdump vec)
+ (executable-find "hexdump"))
+ (throw 'wont-work nil))))
+ (dev (when (string-match-p "\\(^\\|[^%]\\)%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))))
+ (od (when (string-match-p "\\(^\\|[^%]\\)%o" script)
+ (or (if vec (tramp-get-remote-od vec) (executable-find "od"))
+ (throw 'wont-work nil))))
+ (perl (when (string-match-p "\\(^\\|[^%]\\)%p" script)
+ (or
+ (if vec
+ (tramp-get-remote-perl vec) (executable-find "perl"))
+ (throw 'wont-work nil))))
+ (tmp (when (string-match-p "\\(^\\|[^%]\\)%t" script)
+ (or
+ (if vec
+ (tramp-file-local-name (tramp-make-tramp-temp-name vec))
+ (tramp-compat-make-temp-name))
+ (throw 'wont-work nil)))))
+ (format-spec
+ script
+ (format-spec-make ?a awk ?h hdmp ?n dev ?o od ?p perl ?t tmp))))))
+
(defun tramp-maybe-send-script (vec script name)
"Define in remote shell function NAME implemented as SCRIPT.
Only send the definition if it has not already been done."
@@ -4008,14 +4069,15 @@ Only send the definition if it has not already been done."
;; could result in unwanted command expansion. Avoid this.
(setq script (tramp-compat-string-replace
(make-string 1 ?\t) (make-string 8 ? ) script))
- ;; The script could contain a call of Perl. This is masked with `%s'.
- (when (and (string-match-p "%s" script)
- (not (tramp-get-remote-perl vec)))
- (tramp-error vec 'file-error "No Perl available on remote host"))
+ ;; Expand format specifiers.
+ (unless (setq script (tramp-expand-script vec script))
+ (tramp-error
+ vec 'file-error
+ (format "Script %s is not applicable on remote host" name)))
+ ;; Send it.
(tramp-barf-unless-okay
vec
- (format "%s () {\n%s\n}"
- name (format script (tramp-get-remote-perl vec)))
+ (format "%s () {\n%s\n}" name script)
"Script %s sending failed" name)
(tramp-set-connection-property
(tramp-get-connection-process vec) "scripts" (cons name scripts))))))
@@ -4523,7 +4585,7 @@ process to set up. VEC specifies the connection."
(defconst tramp-local-coding-commands
`((b64 base64-encode-region base64-decode-region)
(uu tramp-uuencode-region uudecode-decode-region)
- (pack ,(format tramp-perl-pack "perl") ,(format tramp-perl-unpack "perl")))
+ (pack ,tramp-perl-pack ,tramp-perl-unpack))
"List of local coding commands for inline transfer.
Each item is a list that looks like this:
@@ -4613,6 +4675,8 @@ Goes through the list `tramp-local-coding-commands' and
vec 5 "Checking local encoding function `%s'" loc-enc)
(tramp-message
vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
+ (unless (stringp (setq loc-enc (tramp-expand-script nil loc-enc)))
+ (throw 'wont-work-local nil))
(unless (zerop (tramp-call-local-coding-command loc-enc nil nil))
(throw 'wont-work-local nil)))
(if (not (stringp loc-dec))
@@ -4620,6 +4684,8 @@ Goes through the list `tramp-local-coding-commands' and
vec 5 "Checking local decoding function `%s'" loc-dec)
(tramp-message
vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
+ (unless (stringp (setq loc-dec (tramp-expand-script nil loc-dec)))
+ (throw 'wont-work-local nil))
(unless (zerop (tramp-call-local-coding-command loc-dec nil nil))
(throw 'wont-work-local nil)))
;; Search for remote coding commands with the same format
@@ -4647,35 +4713,8 @@ Goes through the list `tramp-local-coding-commands' and
(unless (stringp rem-enc)
(let ((name (symbol-name rem-enc))
(value (symbol-value rem-enc)))
- ;; Check if remote perl exists when necessary.
- (and (string-match-p "perl" name)
- (not (tramp-get-remote-perl vec))
- (throw 'wont-work-remote nil))
- ;; Check if remote awk exists when necessary.
- (and (string-match-p "\\(^\\|[^%]\\)%a" value)
- (not (tramp-get-remote-awk vec))
- (throw 'wont-work-remote nil))
- ;; Check if remote hexdump exists when necessary.
- (and (string-match-p "\\(^\\|[^%]\\)%h" value)
- (not (tramp-get-remote-hexdump vec))
- (throw 'wont-work-remote nil))
- ;; Check if remote od exists when necessary.
- (and (string-match-p "\\(^\\|[^%]\\)%o" value)
- (not (tramp-get-remote-od vec))
- (throw 'wont-work-remote nil))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
- (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value)
- (setq value
- (format-spec
- value
- (format-spec-make
- ?a (tramp-get-remote-awk vec)
- ?h (tramp-get-remote-hexdump vec)
- ?n (concat
- "2>" (tramp-get-remote-null-device vec))
- ?o (tramp-get-remote-od vec)))
- value (tramp-compat-string-replace "%" "%%" value)))
(tramp-maybe-send-script vec value name)
(setq rem-enc name)))
(tramp-message
@@ -4690,28 +4729,9 @@ Goes through the list `tramp-local-coding-commands' and
(unless (stringp rem-dec)
(let ((name (symbol-name rem-dec))
- (value (symbol-value rem-dec))
- tmpfile)
+ (value (symbol-value rem-dec)))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
- (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value)
- (setq value
- (format-spec
- value
- (format-spec-make
- ?a (tramp-get-remote-awk vec)
- ?h (tramp-get-remote-hexdump vec)
- ?n (concat
- "2>" (tramp-get-remote-null-device vec))
- ?o (tramp-get-remote-od vec)))
- value (tramp-compat-string-replace "%" "%%" value)))
- (when (string-match-p "\\(^\\|[^%]\\)%t" value)
- (setq tmpfile (tramp-make-tramp-temp-name vec)
- value
- (format-spec
- value
- (format-spec-make
- ?t (tramp-file-local-name tmpfile)))))
(tramp-maybe-send-script vec value name)
(setq rem-dec name)))
(tramp-message
@@ -5014,6 +5034,9 @@ connection if a previous connection has died for some reason."
(tramp-message vec 6 "%s" (string-join (process-command p) " "))
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
;; Check whether process is alive.
(tramp-barf-if-no-shell-prompt
p 10
@@ -5123,9 +5146,6 @@ connection if a previous connection has died for some reason."
(setq options ""
target-alist (cdr target-alist)))
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
;; Activate session timeout.
(when (tramp-get-connection-property p "session-timeout" nil)
(run-at-time
@@ -5737,6 +5757,30 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(tramp-message vec 5 "Finding a suitable `gio-monitor' command")
(tramp-find-executable vec "gio" (tramp-get-remote-path vec) t t)))
+(defun tramp-get-remote-gio-file-monitor (vec)
+ "Determine remote GFileMonitor."
+ (with-tramp-connection-property vec "gio-file-monitor"
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 5 "Finding the used GFileMonitor")
+ (when-let ((gio (tramp-get-remote-gio-monitor vec)))
+ ;; Search for the used FileMonitor. There is no known way to
+ ;; get this information directly from gio, so we check for
+ ;; linked libraries of libgio.
+ (when (tramp-send-command-and-check vec (concat "ldd " gio))
+ (goto-char (point-min))
+ (when (re-search-forward "\\S-+/libgio\\S-+")
+ (when (tramp-send-command-and-check
+ vec (concat "strings " (match-string 0)))
+ (goto-char (point-min))
+ (re-search-forward
+ (format
+ "^%s$"
+ (regexp-opt
+ '("GFamFileMonitor" "GFenFileMonitor"
+ "GInotifyFileMonitor" "GKqueueFileMonitor")))
+ nil 'noerror)
+ (intern (match-string 0)))))))))
+
(defun tramp-get-remote-gvfs-monitor-dir (vec)
"Determine remote `gvfs-monitor-dir' command."
(with-tramp-connection-property vec "gvfs-monitor-dir"
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index e5213713320..83c1b58a30d 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -2040,6 +2040,9 @@ If ARGUMENT is non-nil, use it as argument for
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
(condition-case err
(let ((inhibit-message t))
;; Play login scenario.
@@ -2073,9 +2076,6 @@ If ARGUMENT is non-nil, use it as argument for
(tramp-set-connection-property p "smb-share" share)
(tramp-set-connection-property p "chunksize" 1)
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
;; Mark it as connected.
(tramp-set-connection-property p "connected" t))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index b3853aa3d6f..6750a7ff4c6 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -5210,6 +5210,8 @@ Invokes `password-read' if available, `read-passwd' else."
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
(format "%s for %s " (capitalize (match-string 1)) key))))
(auth-source-creation-prompts `((secret . ,pw-prompt)))
+ ;; Use connection-local value.
+ (auth-sources (with-current-buffer (process-buffer proc) auth-sources))
;; We suspend the timers while reading the password.
(stimers (with-timeout-suspend))
auth-info auth-passwd)
@@ -5250,7 +5252,7 @@ Invokes `password-read' if available, `read-passwd' else."
(setq auth-passwd (funcall auth-passwd)))
auth-passwd)
- ;; Try the password cache.
+ ;; Try the password cache. Exists since Emacs 26.1.
(progn
(setq auth-passwd (password-read pw-prompt key)
tramp-password-save-function
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 3eb158dc2c8..5d318bbd2e1 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -304,7 +304,7 @@ This is useful when style-conventions require a certain minimal offset.
Python's PEP8 for example recommends two spaces, so you could do:
\(add-hook \\='python-mode-hook
- (lambda () (set (make-local-variable \\='comment-inline-offset) 2)))
+ (lambda () (setq-local comment-inline-offset 2)))
See `comment-padding' for whole-line comments."
:version "24.3"
@@ -361,21 +361,21 @@ function should first call this function explicitly."
(let ((cs (read-string "No comment syntax is defined. Use: ")))
(if (zerop (length cs))
(error "No comment syntax defined")
- (set (make-local-variable 'comment-start) cs)
- (set (make-local-variable 'comment-start-skip) cs))))
+ (setq-local comment-start cs)
+ (setq-local comment-start-skip cs))))
;; comment-use-syntax
(when (eq comment-use-syntax 'undecided)
- (set (make-local-variable 'comment-use-syntax)
- (let ((st (syntax-table))
- (cs comment-start)
- (ce (if (string= "" comment-end) "\n" comment-end)))
- ;; Try to skip over a comment using forward-comment
- ;; to see if the syntax tables properly recognize it.
- (with-temp-buffer
- (set-syntax-table st)
- (insert cs " hello " ce)
- (goto-char (point-min))
- (and (forward-comment 1) (eobp))))))
+ (setq-local comment-use-syntax
+ (let ((st (syntax-table))
+ (cs comment-start)
+ (ce (if (string= "" comment-end) "\n" comment-end)))
+ ;; Try to skip over a comment using forward-comment
+ ;; to see if the syntax tables properly recognize it.
+ (with-temp-buffer
+ (set-syntax-table st)
+ (insert cs " hello " ce)
+ (goto-char (point-min))
+ (and (forward-comment 1) (eobp))))))
;; comment-padding
(unless comment-padding (setq comment-padding 0))
(when (integerp comment-padding)
@@ -385,9 +385,9 @@ function should first call this function explicitly."
;;(setq comment-end (comment-string-strip comment-end nil t))
;; comment-continue
(unless (or comment-continue (string= comment-end ""))
- (set (make-local-variable 'comment-continue)
- (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
- (substring comment-start 1)))
+ (setq-local comment-continue
+ (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
+ (substring comment-start 1)))
;; Hasn't been necessary yet.
;; (unless (string-match comment-start-skip comment-continue)
;; (kill-local-variable 'comment-continue))
@@ -396,29 +396,29 @@ function should first call this function explicitly."
(unless (and comment-start-skip
;; In case comment-start has changed since last time.
(string-match comment-start-skip comment-start))
- (set (make-local-variable 'comment-start-skip)
- (concat (unless (eq comment-use-syntax t)
- ;; `syntax-ppss' will detect escaping.
- "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)")
- "\\(?:\\s<+\\|"
- (regexp-quote (comment-string-strip comment-start t t))
- ;; Let's not allow any \s- but only [ \t] since \n
- ;; might be both a comment-end marker and \s-.
- "+\\)[ \t]*")))
+ (setq-local comment-start-skip
+ (concat (unless (eq comment-use-syntax t)
+ ;; `syntax-ppss' will detect escaping.
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)")
+ "\\(?:\\s<+\\|"
+ (regexp-quote (comment-string-strip comment-start t t))
+ ;; Let's not allow any \s- but only [ \t] since \n
+ ;; might be both a comment-end marker and \s-.
+ "+\\)[ \t]*")))
(unless (and comment-end-skip
;; In case comment-end has changed since last time.
(string-match comment-end-skip
(if (string= "" comment-end) "\n" comment-end)))
(let ((ce (if (string= "" comment-end) "\n"
(comment-string-strip comment-end t t))))
- (set (make-local-variable 'comment-end-skip)
- ;; We use [ \t] rather than \s- because we don't want to
- ;; remove ^L in C mode when uncommenting.
- (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+")
- "\\|" (regexp-quote (substring ce 0 1))
- (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
- (regexp-quote (substring ce 1))
- "\\)"))))))
+ (setq-local comment-end-skip
+ ;; We use [ \t] rather than \s- because we don't want to
+ ;; remove ^L in C mode when uncommenting.
+ (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+")
+ "\\|" (regexp-quote (substring ce 0 1))
+ (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
+ (regexp-quote (substring ce 1))
+ "\\)"))))))
(defun comment-quote-re (str unp)
(concat (regexp-quote (substring str 0 1))
diff --git a/lisp/outline.el b/lisp/outline.el
index 9b11b86b9d2..85f9de4e1b4 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -318,7 +318,7 @@ See the command `outline-mode' for more information on this mode."
(add-hook 'change-major-mode-hook
(lambda () (outline-minor-mode -1))
nil t)
- (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq-local line-move-ignore-invisible t)
;; Cause use of ellipses for invisible text.
(add-to-invisibility-spec '(outline . t)))
(setq line-move-ignore-invisible nil)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index a744165e0d5..1f3327435e2 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -738,8 +738,8 @@ user actually typed in."
COMPLETEF-SYM should be the symbol where the
dynamic-complete-functions are kept. For comint mode itself,
this is `comint-dynamic-complete-functions'."
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- #'pcomplete-parse-comint-arguments)
+ (setq-local pcomplete-parse-arguments-function
+ #'pcomplete-parse-comint-arguments)
(add-hook 'completion-at-point-functions
#'pcomplete-completions-at-point nil 'local)
(set (make-local-variable completef-sym)
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 1df28a0f376..45afb51041f 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -46,10 +46,10 @@
;;;;
;;;; This section defines the globals that are used in dunnet.
-;;;;
-;;;; IMPORTANT
-;;;; All globals which can change must be saved from 'save-game. Add
-;;;; all new globals to bottom of this section.
+;;
+;; IMPORTANT
+;; All globals which can change must be saved from 'save-game.
+;; Add all new globals to bottom of this section.
(defvar dun-visited '(27))
(defvar dun-current-room 1)
@@ -771,7 +771,6 @@ A hole leads north."
)
-;;; How the user references *all* objects, permanent and regular.
(defconst dun-objnames
'((shovel . 0)
(lamp . 1)
@@ -831,7 +830,8 @@ A hole leads north."
(ladder . -27)
(subway . -28) (train . -28)
(pc . -29) (drive . -29) (coconut . -30) (coconuts . -30)
- (lake . -32) (water . -32)))
+ (lake . -32) (water . -32))
+ "How the user references *all* objects, permanent and regular.")
(dolist (x dun-objnames)
(let (name)
@@ -840,13 +840,6 @@ A hole leads north."
(defconst obj-special 255)
-;;; The initial setup of what objects are in each room.
-;;; Regular objects have whole numbers lower than 255.
-;;; Objects that cannot be taken but might move and are
-;;; described during room description are negative.
-;;; Stuff that is described and might change are 255, and are
-;;; handled specially by 'dun-describe-room.
-
(defvar dun-room-objects (list nil
(list obj-shovel) ;; treasure-room
@@ -899,10 +892,13 @@ A hole leads north."
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-nil))
-
-;;; These are objects in a room that are only described in the
-;;; room description. They are permanent.
+nil)
+ "The initial setup of what objects are in each room.
+Regular objects have whole numbers lower than 255.
+Objects that cannot be taken but might move and are
+described during room description are negative.
+Stuff that is described and might change are 255, and are
+handled specially by 'dun-describe-room.")
(defconst dun-room-silents (list nil
(list obj-tree obj-coconut) ;; dead-end
@@ -947,12 +943,11 @@ nil))
nil nil nil nil nil nil nil nil
(list obj-pc) ;; pc-area
nil nil nil nil nil nil
-))
+ )
+ "These are objects in a room that are only described in the
+room description. They are permanent.")
(defvar dun-inventory '(1))
-;;; Descriptions of objects, as they appear in the room description, and
-;;; the inventory.
-
(defconst dun-objects
'(("There is a shovel here." "A shovel") ;0
("There is a lamp nearby." "A lamp") ;1
@@ -982,26 +977,24 @@ nil))
("There is a valuable amethyst here." "An amethyst") ;24
("The Mona Lisa is here." "The Mona Lisa") ;25
("There is a 100 dollar bill here." "A $100 bill") ;26
- ("There is a floppy disk here." "A floppy disk"))) ;27
-
-;;; Weight of objects
+ ("There is a floppy disk here." "A floppy disk")) ;27
+ "Descriptions of objects, as they appear in the room description, and
+the inventory.")
(defconst dun-object-lbs
- '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0))
+ '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)
+ "Weight of objects.")
(defconst dun-object-pts
'(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0))
-;;; Unix representation of objects.
(defconst dun-objfiles
'("shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o"
"rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o"
"gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o"
"coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o"
- "ruby.o" "amethyst.o"))
-
-;;; These are the descriptions for the negative numbered objects from
-;;; dun-room-objects
+ "ruby.o" "amethyst.o")
+ "Unix representation of objects.")
(defconst dun-perm-objects
'(nil
@@ -1016,12 +1009,11 @@ nil))
("There is a box with a slit in it, bolted to the wall here.")
nil nil
("There is a bus here.")
- nil nil nil))
+ nil nil nil)
+ "These are the descriptions for the negative numbered objects from
+`dun-room-objects'.")
-;;; These are the descriptions the user gets when regular objects are
-;;; examined.
-
(defconst dun-physobj-desc '(
"It is a normal shovel with a price tag attached that says $19.99."
"The lamp is hand-crafted by Geppetto."
@@ -1043,10 +1035,8 @@ nil nil
"They are old coins from the 19th century."
"It is a valuable Fabrege egg."
"It is a plain glass jar."
-nil nil nil nil nil))
-
-;;; These are the descriptions the user gets when non-regular objects
-;;; are examined.
+nil nil nil nil nil)
+ "The descriptions the user gets when regular objects are examined.")
(defconst dun-permobj-desc
'(nil
@@ -1087,7 +1077,8 @@ it. It is very big, though."
nil nil nil nil
"It is a normal ladder that is permanently attached to the hole."
"It is a passenger train that is ready to go."
-"It is a personal computer that has only one floppy disk drive."))
+"It is a personal computer that has only one floppy disk drive.")
+ "The descriptions the user gets when non-regular objects are examined.")
(defconst dun-diggables
(list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil
@@ -1189,10 +1180,9 @@ treasures for points?" "4" "four")
;;;; This section contains all of the verbs and commands.
;;;;
-;;; Give long description of room if haven't been there yet. Otherwise
-;;; short. Also give long if we were called with negative room number.
-
(defun dun-describe-room (room)
+ "Give long description of room if haven't been there yet.
+Otherwise short. Also give long if we were called with negative room number."
(if (and (not (member (abs room) dun-light-rooms))
(not (member obj-lamp dun-inventory))
(not (member obj-lamp (nth dun-current-room dun-room-objects))))
@@ -1222,10 +1212,9 @@ treasures for points?" "4" "four")
(if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus)
(dun-mprincl "You are on the bus."))))
-;;; There is a special object in the room. This object's description,
-;;; or lack thereof, depends on certain conditions.
-
(defun dun-special-object ()
+ "There is a special object in the room. This object's description,
+or lack thereof, depends on certain conditions."
(cond
((= dun-current-room computer-room)
(if dun-computer
@@ -1298,10 +1287,9 @@ disk bursts into flames, and disintegrates.")
(defun dun-quit (_args)
(dun-die nil))
-;;; Print every object in player's inventory. Special case for the jar,
-;;; as we must also print what is in it.
-
(defun dun-inven (_args)
+ "Print every object in player's inventory.
+Special case for the jar, as we must also print what is in it."
(dun-mprincl "You currently have:")
(dolist (curobj dun-inventory)
(when curobj
@@ -1352,9 +1340,8 @@ on your head.")
(if (member objnum (list obj-food obj-weight obj-jar))
(dun-drop-check objnum)))))))
-;;; Dropping certain things causes things to happen.
-
(defun dun-drop-check (objnum)
+ "Dropping certain things causes things to happen."
(cond
((and (= objnum obj-food) (= dun-room bear-hangout)
(member obj-bear (nth bear-hangout dun-room-objects)))
@@ -1381,9 +1368,8 @@ through.")))
((and (= objnum obj-weight) (= dun-current-room maze-button-room))
(dun-mprincl "A passageway opens."))))
-;;; Give long description of current room, or an object.
-
(defun dun-examine (obj)
+ "Give long description of current room, or an object."
(let ((objnum (dun-objnum-from-args obj)))
(cond
((eq objnum obj-special)
@@ -1474,10 +1460,9 @@ For an explosive time, go to Fourth St. and Vermont.")
(setq total (+ total (nth x dun-object-lbs))))
total))
-;;; We try to take an object that is untakable. Print a message
-;;; depending on what it is.
-
(defun dun-try-take (_obj)
+ "We try to take an object that is untakable.
+Print a message depending on what it is."
(dun-mprinc "You cannot take that."))
(defun dun-dig (_args)
@@ -1670,15 +1655,15 @@ just try dropping it."))
(defun dun-go (args)
(if (or (not (car args))
(eq (dun-doverb dun-ignore dun-verblist (car args)
- (cdr (cdr args))) -1))
+ (cdr (cdr args)))
+ -1))
(dun-mprincl "I don't understand where you want me to go.")))
-;;; Uses the dungeon-map to figure out where we are going. If the
-;;; requested direction yields 255, we know something special is
-;;; supposed to happen, or perhaps you can't go that way unless
-;;; certain conditions are met.
-
(defun dun-move (dir)
+ ;; Uses the dungeon-map to figure out where we are going. If the
+ ;; requested direction yields 255, we know something special is
+ ;; supposed to happen, or perhaps you can't go that way unless
+ ;; certain conditions are met.
(if (and (not (member dun-current-room dun-light-rooms))
(not (member obj-lamp dun-inventory))
(not (member obj-lamp (nth dun-current-room dun-room-objects))))
@@ -1709,17 +1694,17 @@ body.")
(list obj-bus)))))
(setq dun-current-room newroom)))))))
-;;; Movement in this direction causes something special to happen if the
-;;; right conditions exist. It may be that you can't go this way unless
-;;; you have a key, or a passage has been opened.
-
-;;; coding note: Each check of the current room is on the same 'if' level,
-;;; i.e. there aren't else's. If two rooms next to each other have
-;;; specials, and they are connected by specials, this could cause
-;;; a problem. Be careful when adding them to consider this, and
-;;; perhaps use else's.
-
(defun dun-special-move (dir)
+ ;; Movement in this direction causes something special to happen if the
+ ;; right conditions exist. It may be that you can't go this way unless
+ ;; you have a key, or a passage has been opened.
+
+ ;; coding note: Each check of the current room is on the same 'if' level,
+ ;; i.e. there aren't else's. If two rooms next to each other have
+ ;; specials, and they are connected by specials, this could cause
+ ;; a problem. Be careful when adding them to consider this, and
+ ;; perhaps use else's.
+
(if (= dun-current-room building-front)
(if (not (member obj-key dun-inventory))
(dun-mprincl "You don't have a key that can open this door.")
@@ -2152,10 +2137,10 @@ for a moment, then straighten yourself up.\n")
;;;;
-;;; Function which takes a verb and a list of other words. Calls proper
-;;; function associated with the verb, and passes along the other words.
-
(defun dun-doverb (ignore verblist verb rest)
+ "Take a verb and a list of other words.
+Calls proper function associated with the verb, and passes along the
+other words."
(when verb
(if (member (intern verb) ignore)
(if (not (car rest)) -1
@@ -2165,9 +2150,8 @@ for a moment, then straighten yourself up.\n")
(funcall (cdr (assq (intern verb) verblist)) rest)))))
-;;; Function to take a string and change it into a list of lowercase words.
-
(defun dun-listify-string (strin)
+ "Take a string and change it into a list of lowercase words."
(let (pos ret-list end-pos)
(setq pos 0)
(setq ret-list nil)
@@ -2177,7 +2161,8 @@ for a moment, then straighten yourself up.\n")
(setq ret-list (append ret-list (list
(downcase
(substring strin pos end-pos))))))
- (setq pos (+ end-pos 1))) ret-list))
+ (setq pos (+ end-pos 1)))
+ ret-list))
(defun dun-listify-string2 (strin)
(let (pos ret-list end-pos)
@@ -2194,10 +2179,8 @@ for a moment, then straighten yourself up.\n")
(defun dun-replace (list n number)
(rplaca (nthcdr n list) number))
-
-;;; Get the first non-ignored word from a list.
-
(defun dun-firstword (list)
+ "Get the first non-ignored word from a list."
(when (car list)
(while (and list (memq (intern (car list)) dun-ignore))
(setq list (cdr list)))
@@ -2209,10 +2192,9 @@ for a moment, then straighten yourself up.\n")
(setq list (cdr list)))
list))
-;;; parse a line passed in as a string Call the proper verb with the
-;;; rest of the line passed in as a list.
-
(defun dun-vparse (ignore verblist line)
+ "Parse a line passed in as a string.
+Call the proper verb with the rest of the line passed in as a list."
(dun-mprinc "\n")
(setq dun-line-list (dun-listify-string (concat line " ")))
(dun-doverb ignore verblist (car dun-line-list) (cdr dun-line-list)))
@@ -2222,54 +2204,47 @@ for a moment, then straighten yourself up.\n")
(setq dun-line-list (dun-listify-string2 (concat line " ")))
(dun-doverb ignore verblist (car dun-line-list) (cdr dun-line-list)))
-;;; Read a line, in window mode
-
(defun dun-read-line ()
+ "Read a line, in window mode."
(let ((line (read-string "")))
(dun-mprinc line)
line))
-;;; Insert something into the window buffer
-
(defun dun-minsert (&rest args)
+ "Insert something into the window buffer."
(dolist (arg args)
(if (stringp arg)
(insert arg)
(insert (prin1-to-string arg)))))
-;;; Print something out, in window mode
-
(defun dun-mprinc (&rest args)
+ "Print something out, in window mode."
(dolist (arg args)
(if (stringp arg)
(insert arg)
(insert (prin1-to-string arg)))))
-;;; In window mode, keep screen from jumping by keeping last line at
-;;; the bottom of the screen.
-
(defun dun-fix-screen ()
+ "In window mode, keep screen from jumping by keeping last line at
+the bottom of the screen."
(interactive)
(forward-line (- 0 (- (window-height) 2 )))
(set-window-start (selected-window) (point))
(goto-char (point-max)))
-;;; Insert something into the buffer, followed by newline.
-
(defun dun-minsertl (&rest args)
+ "Insert something into the buffer, followed by newline."
(apply #'dun-minsert args)
(dun-minsert "\n"))
-;;; Print something, followed by a newline.
-
(defun dun-mprincl (&rest args)
+ "Print something, followed by a newline."
(apply #'dun-mprinc args)
(dun-mprinc "\n"))
-;;; Function which will get an object number given the list of
-;;; words in the command, except for the verb.
-
(defun dun-objnum-from-args (obj)
+ "Get an object number given the list of words in the command,
+except for the verb."
(setq obj (dun-firstword obj))
(if (not obj)
obj-special
@@ -2285,9 +2260,8 @@ for a moment, then straighten yourself up.\n")
nil
result)))
-;;; Given a unix style pathname, build a list of path components (recursive)
-
(defun dun-get-path (dirstring startlist)
+ "Given a unix style pathname, build a list of path components (recursive)"
(let (slash)
(if (= (length dirstring) 0)
startlist
@@ -2299,10 +2273,9 @@ for a moment, then straighten yourself up.\n")
(append startlist
(list (substring dirstring 0 slash)))))))))
-;;; Function to put objects in the treasure room. Also prints current
-;;; score to let user know he has scored.
-
(defun dun-put-objs-in-treas (objlist)
+ "Put objects in the treasure room.
+Also prints current score to let user know he has scored."
(let (oscore newscore)
(setq oscore (dun-reg-score))
(dun-replace dun-room-objects 0 (append (nth 0 dun-room-objects) objlist))
@@ -2310,9 +2283,8 @@ for a moment, then straighten yourself up.\n")
(if (not (= oscore newscore))
(dun-score nil))))
-;;; Load an encrypted file, and eval it.
-
(defun dun-load-d (filename)
+ "Load an encrypted file, and eval it."
(let ((result t))
(with-temp-buffer
(condition-case nil
@@ -3154,14 +3126,16 @@ File not found")))
(dun-mprinc "\n")
(dun-batch-loop))
-(when noninteractive
- (fset 'dun-mprinc 'dun-batch-mprinc)
- (fset 'dun-mprincl 'dun-batch-mprincl)
- (fset 'dun-vparse 'dun-batch-parse)
- (fset 'dun-parse2 'dun-batch-parse2)
- (fset 'dun-read-line 'dun-batch-read-line)
- (fset 'dun-dos-interface 'dun-batch-dos-interface)
- (fset 'dun-unix-interface 'dun-batch-unix-interface)
+;;;###autoload
+(defun dun-batch ()
+ "Start `dunnet' in batch mode."
+ (fset 'dun-mprinc #'dun-batch-mprinc)
+ (fset 'dun-mprincl #'dun-batch-mprincl)
+ (fset 'dun-vparse #'dun-batch-parse)
+ (fset 'dun-parse2 #'dun-batch-parse2)
+ (fset 'dun-read-line #'dun-batch-read-line)
+ (fset 'dun-dos-interface #'dun-batch-dos-interface)
+ (fset 'dun-unix-interface #'dun-batch-unix-interface)
(dun-mprinc "\n")
(setq dun-batch-mode t)
(dun-batch-loop))
diff --git a/lisp/proced.el b/lisp/proced.el
index 203d70331ce..5d4318d81f6 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -664,9 +664,9 @@ After displaying or updating a Proced buffer, Proced runs the normal hook
truncate-lines t
header-line-format '(:eval (proced-header-line)))
(add-hook 'post-command-hook #'force-mode-line-update nil t) ;; FIXME: Why?
- (set (make-local-variable 'revert-buffer-function) #'proced-revert)
- (set (make-local-variable 'font-lock-defaults)
- '(proced-font-lock-keywords t nil nil beginning-of-line))
+ (setq-local revert-buffer-function #'proced-revert)
+ (setq-local font-lock-defaults
+ '(proced-font-lock-keywords t nil nil beginning-of-line))
(if (and (not proced-auto-update-timer) proced-auto-update-interval)
(setq proced-auto-update-timer
(run-at-time t proced-auto-update-interval
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 5e2ce71f536..f14ffb38cde 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -10837,11 +10837,11 @@ comment at the start of cc-engine.el for more info."
(low-lim (max (or lim (point-min)) (or macro-start (point-min))))
before-lparen after-rparen
(here (point))
- (pp-count-out 20) ; Max number of paren/brace constructs before
- ; we give up.
+ (pp-count-out 20) ; Max number of paren/brace constructs before
+ ; we give up
ids ; List of identifiers in the parenthesized list.
id-start after-prec-token decl-or-cast decl-res
- c-last-identifier-range identifier-ok)
+ c-last-identifier-range semi-position+1)
(narrow-to-region low-lim (or macro-end (point-max)))
;; Search backwards for the defun's argument list. We give up if we
@@ -10875,8 +10875,8 @@ comment at the start of cc-engine.el for more info."
(setq after-rparen (point)))
((eq (char-before) ?\])
(setq after-rparen nil))
- (t ; either } (hit previous defun) or = or no more
- ; parens/brackets.
+ (t ; either } (hit previous defun) or = or no more
+ ; parens/brackets.
(throw 'knr nil)))
(if after-rparen
@@ -10933,31 +10933,35 @@ comment at the start of cc-engine.el for more info."
(forward-char) ; over the )
(setq after-prec-token after-rparen)
(c-forward-syntactic-ws)
+ ;; Each time around the following checks one
+ ;; declaration (which may contain several identifiers).
(while (and
- (or (consp (setq decl-or-cast
- (c-forward-decl-or-cast-1
- after-prec-token
- nil ; Or 'arglist ???
- nil)))
- (progn
- (goto-char after-prec-token)
- (c-forward-syntactic-ws)
- (setq identifier-ok (eq (char-after) ?{))
- nil))
- (eq (char-after) ?\;)
- (setq after-prec-token (1+ (point)))
+ (consp (setq decl-or-cast
+ (c-forward-decl-or-cast-1
+ after-prec-token
+ nil ; Or 'arglist ???
+ nil)))
+ (memq (char-after) '(?\; ?\,))
(goto-char (car decl-or-cast))
- (setq decl-res (c-forward-declarator))
- (setq identifier-ok
- (member (buffer-substring-no-properties
- (car decl-res) (cadr decl-res))
- ids))
- (progn
- (goto-char after-prec-token)
- (prog1 (< (point) here)
- (c-forward-syntactic-ws))))
- (setq identifier-ok nil))
- identifier-ok))
+ (save-excursion
+ (setq semi-position+1
+ (c-syntactic-re-search-forward
+ ";" (+ (point) 1000) t)))
+ (c-do-declarators
+ semi-position+1 t nil nil
+ (lambda (id-start id-end _next _not-top
+ _func _init)
+ (if (not (member
+ (buffer-substring-no-properties
+ id-start id-end)
+ ids))
+ (throw 'knr nil))))
+
+ (progn (forward-char)
+ (<= (point) here))
+ (progn (c-forward-syntactic-ws)
+ t)))
+ t))
;; ...Yes. We've identified the function's argument list.
(throw 'knr
(progn (goto-char after-rparen)
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index a8fe485b702..6e915440f95 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -1314,19 +1314,19 @@ see. Use it by enabling `eldoc-mode'."
(append bounds (list (cdr flist))))))
(defun cfengine-common-settings ()
- (set (make-local-variable 'syntax-propertize-function)
- ;; In the main syntax-table, \ is marked as a punctuation, because
- ;; of its use in DOS-style directory separators. Here we try to
- ;; recognize the cases where \ is used as an escape inside strings.
- (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
- (set (make-local-variable 'parens-require-spaces) nil)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-start-skip)
- "\\(\\(?:^\\|[^\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
+ (setq-local syntax-propertize-function
+ ;; In the main syntax-table, \ is marked as a punctuation, because
+ ;; of its use in DOS-style directory separators. Here we try to
+ ;; recognize the cases where \ is used as an escape inside strings.
+ (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
+ (setq-local parens-require-spaces nil)
+ (setq-local comment-start "# ")
+ (setq-local comment-start-skip
+ "\\(\\(?:^\\|[^\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
;; Like Lisp mode. Without this, we lose with, say,
;; `backward-up-list' when there's an unbalanced quote in a
;; preceding comment.
- (set (make-local-variable 'parse-sexp-ignore-comments) t))
+ (setq-local parse-sexp-ignore-comments t))
(defun cfengine-common-syntax (table)
;; The syntax defaults seem OK to give reasonable word movement.
@@ -1374,7 +1374,7 @@ to the action header."
(cfengine-common-settings)
(cfengine-common-syntax cfengine3-mode-syntax-table)
- (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
+ (setq-local indent-line-function #'cfengine3-indent-line)
(setq font-lock-defaults
'(cfengine3-font-lock-keywords
@@ -1384,11 +1384,11 @@ to the action header."
;; `compile-command' is almost never a `make' call with CFEngine so
;; we override it
(when cfengine-cf-promises
- (set (make-local-variable 'compile-command)
- (concat cfengine-cf-promises
- " -f "
- (when buffer-file-name
- (shell-quote-argument buffer-file-name)))))
+ (setq-local compile-command
+ (concat cfengine-cf-promises
+ " -f "
+ (when buffer-file-name
+ (shell-quote-argument buffer-file-name)))))
(add-hook 'eldoc-documentation-functions
#'cfengine3-documentation-function nil t)
@@ -1418,20 +1418,18 @@ to the action header."
;; should avoid potential confusion in some cases.
(modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table)
- (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line)
- (set (make-local-variable 'outline-regexp) "[ \t]*\\(\\sw\\|\\s_\\)+:+")
- (set (make-local-variable 'outline-level) #'cfengine2-outline-level)
- (set (make-local-variable 'fill-paragraph-function)
- #'cfengine-fill-paragraph)
+ (setq-local indent-line-function #'cfengine2-indent-line)
+ (setq-local outline-regexp "[ \t]*\\(\\sw\\|\\s_\\)+:+")
+ (setq-local outline-level #'cfengine2-outline-level)
+ (setq-local fill-paragraph-function #'cfengine-fill-paragraph)
(define-abbrev-table 'cfengine2-mode-abbrev-table cfengine-mode-abbrevs)
(setq font-lock-defaults
'(cfengine2-font-lock-keywords nil nil nil beginning-of-line))
;; Fixme: set the args of functions in evaluated classes to string
;; syntax, and then obey syntax properties.
(setq imenu-generic-expression cfengine2-imenu-expression)
- (set (make-local-variable 'beginning-of-defun-function)
- #'cfengine2-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function) #'cfengine2-end-of-defun))
+ (setq-local beginning-of-defun-function #'cfengine2-beginning-of-defun)
+ (setq-local end-of-defun-function #'cfengine2-end-of-defun))
;;;###autoload
(defun cfengine-auto-mode ()
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 787f5d5ef30..d2293151c7d 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -241,11 +241,20 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; GradleStyleMessagerRenderer.kt in kotlin sources, see
;; https://youtrack.jetbrains.com/issue/KT-34683).
(gradle-kotlin
- ,(concat
- "^\\(?:\\(w\\)\\|.\\): *" ;type
- "\\(\\(?:[A-Za-z]:\\)?[^:\n]+\\): *" ;file
- "(\\([0-9]+\\), *\\([0-9]+\\))") ;line, column
- 2 3 4 (1))
+ ,(rx bol
+ (| (group "w") ; 1: warning
+ (group (in "iv")) ; 2: info
+ "e") ; error
+ ": "
+ (group ; 3: file
+ (? (in "A-Za-z") ":")
+ (+ (not (in "\n:"))))
+ ": ("
+ (group (+ digit)) ; 4: line
+ ", "
+ (group (+ digit)) ; 5: column
+ "): ")
+ 3 4 5 (1 . 2))
(iar
"^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
@@ -807,7 +816,7 @@ You might also use mode hooks to specify it in certain modes, like this:
(lambda ()
(unless (or (file-exists-p \"makefile\")
(file-exists-p \"Makefile\"))
- (set (make-local-variable \\='compile-command)
+ (setq-local compile-command
(concat \"make -k \"
(if buffer-file-name
(shell-quote-argument
@@ -1839,14 +1848,13 @@ Returns the compilation buffer created."
;; default-directory' can't be used reliably for that because it may be
;; affected by the special handling of "cd ...;".
;; NB: must be done after (funcall mode) as that resets local variables
- (set (make-local-variable 'compilation-directory) thisdir)
- (set (make-local-variable 'compilation-environment) thisenv)
+ (setq-local compilation-directory thisdir)
+ (setq-local compilation-environment thisenv)
(if highlight-regexp
- (set (make-local-variable 'compilation-highlight-regexp)
- highlight-regexp))
+ (setq-local compilation-highlight-regexp highlight-regexp))
(if (or compilation-auto-jump-to-first-error
(eq compilation-scroll-output 'first-error))
- (set (make-local-variable 'compilation-auto-jump-to-next) t))
+ (setq-local compilation-auto-jump-to-next t))
;; Output a mode setter, for saving and later reloading this buffer.
(insert "-*- mode: " name-of-mode
"; default-directory: "
@@ -1868,13 +1876,13 @@ Returns the compilation buffer created."
(let ((process-environment
(append
compilation-environment
- (comint-term-environment)
+ (and (derived-mode-p 'comint-mode)
+ (comint-term-environment))
(list (format "INSIDE_EMACS=%s,compile" emacs-version))
(copy-sequence process-environment))))
- (set (make-local-variable 'compilation-arguments)
- (list command mode name-function highlight-regexp))
- (set (make-local-variable 'revert-buffer-function)
- 'compilation-revert-buffer)
+ (setq-local compilation-arguments
+ (list command mode name-function highlight-regexp))
+ (setq-local revert-buffer-function 'compilation-revert-buffer)
(and outwin
;; Forcing the window-start overrides the usual redisplay
;; feature of bringing point into view, so setting the
@@ -2179,20 +2187,19 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
(kill-all-local-variables)
(use-local-map compilation-mode-map)
;; Let windows scroll along with the output.
- (set (make-local-variable 'window-point-insertion-type) t)
- (set (make-local-variable 'tool-bar-map) compilation-mode-tool-bar-map)
+ (setq-local window-point-insertion-type t)
+ (setq-local tool-bar-map compilation-mode-tool-bar-map)
(setq major-mode 'compilation-mode ; FIXME: Use define-derived-mode.
mode-name (or name-of-mode "Compilation"))
- (set (make-local-variable 'page-delimiter)
- compilation-page-delimiter)
- ;; (set (make-local-variable 'compilation-buffer-modtime) nil)
+ (setq-local page-delimiter compilation-page-delimiter)
+ ;; (setq-local compilation-buffer-modtime nil)
(compilation-setup)
;; Turn off deferred fontifications in the compilation buffer, if
;; the user turned them on globally. This is because idle timers
;; aren't re-run after receiving input from a subprocess, so the
;; buffer is left unfontified after the compilation exits, until
;; some other input event happens.
- (set (make-local-variable 'jit-lock-defer-time) nil)
+ (setq-local jit-lock-defer-time nil)
(setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
@@ -2262,7 +2269,7 @@ Optional argument MINOR indicates this is called from
(setq-local compilation-num-errors-found 0)
(setq-local compilation-num-warnings-found 0)
(setq-local compilation-num-infos-found 0)
- (set (make-local-variable 'overlay-arrow-string) "")
+ (setq-local overlay-arrow-string "")
(setq next-error-overlay-arrow-position nil)
(add-hook 'kill-buffer-hook
(lambda () (setq next-error-overlay-arrow-position nil)) nil t)
@@ -2270,10 +2277,10 @@ Optional argument MINOR indicates this is called from
;; with the next-error function in simple.el, and it's only
;; coincidentally named similarly to compilation-next-error.
(setq next-error-function 'compilation-next-error-function)
- (set (make-local-variable 'comint-file-name-prefix)
- (or (file-remote-p default-directory) ""))
- (set (make-local-variable 'compilation-locs)
- (make-hash-table :test 'equal :weakness 'value))
+ (setq-local comint-file-name-prefix
+ (or (file-remote-p default-directory) ""))
+ (setq-local compilation-locs
+ (make-hash-table :test 'equal :weakness 'value))
;; It's generally preferable to use after-change-functions since they
;; can be subject to combine-after-change-calls, but if we do that, we risk
;; running our hook after font-lock, resulting in incorrect refontification.
@@ -2411,8 +2418,7 @@ and runs `compilation-filter-hook'."
(set-marker (process-mark proc) (point))
;; Update the number of errors in compilation-mode-line-errors
(compilation--ensure-parse (point))
- ;; (set (make-local-variable 'compilation-buffer-modtime)
- ;; (current-time))
+ ;; (setq-local compilation-buffer-modtime (current-time))
(run-hooks 'compilation-filter-hook))
(goto-char pos)
(narrow-to-region min max)
@@ -3166,9 +3172,9 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
;; Again, since this command is used in buffers that contain several
;; compilations, to set the beginning of "this compilation", it's a good
;; place to reset compilation-auto-jump-to-next.
- (set (make-local-variable 'compilation-auto-jump-to-next)
- (or compilation-auto-jump-to-first-error
- (eq compilation-scroll-output 'first-error))))
+ (setq-local compilation-auto-jump-to-next
+ (or compilation-auto-jump-to-first-error
+ (eq compilation-scroll-output 'first-error))))
(provide 'compile)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 48f0a34880e..ae839a66220 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1599,111 +1599,106 @@ or as help on variables `cperl-tips', `cperl-problems',
;; Until Emacs is multi-threaded, we do not actually need it local:
(make-local-variable 'cperl-font-lock-multiline-start)
(make-local-variable 'cperl-font-locking)
- (set (make-local-variable 'outline-regexp) cperl-outline-regexp)
- (set (make-local-variable 'outline-level) 'cperl-outline-level)
- (set (make-local-variable 'add-log-current-defun-function)
- (lambda ()
- (save-excursion
- (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
- (match-string-no-properties 1)))))
+ (setq-local outline-regexp cperl-outline-regexp)
+ (setq-local outline-level 'cperl-outline-level)
+ (setq-local add-log-current-defun-function
+ (lambda ()
+ (save-excursion
+ (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
+ (match-string-no-properties 1)))))
- (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
- (set (make-local-variable 'indent-line-function) #'cperl-indent-line)
- (set (make-local-variable 'require-final-newline) mode-require-final-newline)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-column) cperl-comment-column)
- (set (make-local-variable 'comment-start-skip) "#+ *")
+ (setq-local paragraph-start (concat "^$\\|" page-delimiter))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local paragraph-ignore-fill-prefix t)
+ (setq-local indent-line-function #'cperl-indent-line)
+ (setq-local require-final-newline mode-require-final-newline)
+ (setq-local comment-start "# ")
+ (setq-local comment-end "")
+ (setq-local comment-column cperl-comment-column)
+ (setq-local comment-start-skip "#+ *")
;; "[ \t]*sub"
;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
;; cperl-maybe-white-and-comment-rex ; 15=pre-block
- (set (make-local-variable 'defun-prompt-regexp)
- (concat "^[ \t]*\\("
- cperl-sub-regexp
- (cperl-after-sub-regexp 'named 'attr-groups)
- "\\|" ; per toke.c
- "\\(BEGIN\\|UNITCHECK\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
- "\\)"
- cperl-maybe-white-and-comment-rex))
- (set (make-local-variable 'comment-indent-function) #'cperl-comment-indent)
- (set (make-local-variable 'fill-paragraph-function)
- #'cperl-fill-paragraph)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'indent-region-function) #'cperl-indent-region)
+ (setq-local defun-prompt-regexp
+ (concat "^[ \t]*\\("
+ cperl-sub-regexp
+ (cperl-after-sub-regexp 'named 'attr-groups)
+ "\\|" ; per toke.c
+ "\\(BEGIN\\|UNITCHECK\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
+ "\\)"
+ cperl-maybe-white-and-comment-rex))
+ (setq-local comment-indent-function #'cperl-comment-indent)
+ (setq-local fill-paragraph-function #'cperl-fill-paragraph)
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local indent-region-function #'cperl-indent-region)
;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off!
- (set (make-local-variable 'imenu-create-index-function)
- #'cperl-imenu--create-perl-index)
- (set (make-local-variable 'imenu-sort-function) nil)
- (set (make-local-variable 'vc-rcs-header) cperl-vc-rcs-header)
- (set (make-local-variable 'vc-sccs-header) cperl-vc-sccs-header)
+ (setq-local imenu-create-index-function #'cperl-imenu--create-perl-index)
+ (setq-local imenu-sort-function nil)
+ (setq-local vc-rcs-header cperl-vc-rcs-header)
+ (setq-local vc-sccs-header cperl-vc-sccs-header)
(cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
- (set (make-local-variable 'compilation-error-regexp-alist-alist)
- (cons (cons 'cperl (car cperl-compilation-error-regexp-alist))
- compilation-error-regexp-alist-alist))
+ (setq-local compilation-error-regexp-alist-alist
+ (cons (cons 'cperl (car cperl-compilation-error-regexp-alist))
+ compilation-error-regexp-alist-alist))
(if (fboundp 'compilation-build-compilation-error-regexp-alist)
(let ((f 'compilation-build-compilation-error-regexp-alist))
(funcall f))
(make-local-variable 'compilation-error-regexp-alist)
(push 'cperl compilation-error-regexp-alist)))
((boundp 'compilation-error-regexp-alist);; xemacs 19.x
- (set (make-local-variable 'compilation-error-regexp-alist)
- (append cperl-compilation-error-regexp-alist
- compilation-error-regexp-alist))))
- (set (make-local-variable 'font-lock-defaults)
- '((cperl-load-font-lock-keywords
- cperl-load-font-lock-keywords-1
- cperl-load-font-lock-keywords-2) nil nil ((?_ . "w"))))
+ (setq-local compilation-error-regexp-alist
+ (append cperl-compilation-error-regexp-alist
+ compilation-error-regexp-alist))))
+ (setq-local font-lock-defaults
+ '((cperl-load-font-lock-keywords
+ cperl-load-font-lock-keywords-1
+ cperl-load-font-lock-keywords-2)
+ nil nil ((?_ . "w"))))
;; Reset syntaxification cache.
- (set (make-local-variable 'cperl-syntax-state) nil)
+ (setq-local cperl-syntax-state nil)
(if cperl-use-syntax-table-text-property
(if (eval-when-compile (fboundp 'syntax-propertize-rules))
(progn
;; Reset syntaxification cache.
- (set (make-local-variable 'cperl-syntax-done-to) nil)
- (set (make-local-variable 'syntax-propertize-function)
- (lambda (start end)
- (goto-char start)
- ;; Even if cperl-fontify-syntaxically has already gone
- ;; beyond `start', syntax-propertize has just removed
- ;; syntax-table properties between start and end, so we have
- ;; to re-apply them.
- (setq cperl-syntax-done-to start)
- (cperl-fontify-syntaxically end))))
+ (setq-local cperl-syntax-done-to nil)
+ (setq-local syntax-propertize-function
+ (lambda (start end)
+ (goto-char start)
+ ;; Even if cperl-fontify-syntaxically has already gone
+ ;; beyond `start', syntax-propertize has just removed
+ ;; syntax-table properties between start and end, so we have
+ ;; to re-apply them.
+ (setq cperl-syntax-done-to start)
+ (cperl-fontify-syntaxically end))))
;; Do not introduce variable if not needed, we check it!
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- ;; Fix broken font-lock:
- (or (boundp 'font-lock-unfontify-region-function)
- (setq font-lock-unfontify-region-function
- #'font-lock-default-unfontify-region))
+ (setq-local parse-sexp-lookup-properties t)
;; Our: just a plug for wrong font-lock
- (set (make-local-variable 'font-lock-unfontify-region-function)
- ;; not present with old Emacs
- #'cperl-font-lock-unfontify-region-function)
+ (setq-local font-lock-unfontify-region-function
+ ;; not present with old Emacs
+ #'cperl-font-lock-unfontify-region-function)
;; Reset syntaxification cache.
- (set (make-local-variable 'cperl-syntax-done-to) nil)
- (set (make-local-variable 'font-lock-syntactic-keywords)
- (if cperl-syntaxify-by-font-lock
- '((cperl-fontify-syntaxically))
- ;; unless font-lock-syntactic-keywords, font-lock (pre-22.1)
- ;; used to ignore syntax-table text-properties. (t) is a hack
- ;; to make font-lock think that font-lock-syntactic-keywords
- ;; are defined.
- '(t)))))
+ (setq-local cperl-syntax-done-to nil)
+ (setq-local font-lock-syntactic-keywords
+ (if cperl-syntaxify-by-font-lock
+ '((cperl-fontify-syntaxically))
+ ;; unless font-lock-syntactic-keywords, font-lock (pre-22.1)
+ ;; used to ignore syntax-table text-properties. (t) is a hack
+ ;; to make font-lock think that font-lock-syntactic-keywords
+ ;; are defined.
+ '(t)))))
(setq cperl-font-lock-multiline t) ; Not localized...
- (set (make-local-variable 'font-lock-multiline) t)
- (set (make-local-variable 'font-lock-fontify-region-function)
- #'cperl-font-lock-fontify-region-function)
+ (setq-local font-lock-multiline t)
+ (setq-local font-lock-fontify-region-function
+ #'cperl-font-lock-fontify-region-function)
(make-local-variable 'cperl-old-style)
- (set (make-local-variable 'normal-auto-fill-function)
- #'cperl-do-auto-fill)
+ (setq-local normal-auto-fill-function
+ #'cperl-do-auto-fill)
(if (cperl-val 'cperl-font-lock)
(progn (or cperl-faces-init (cperl-init-faces))
(font-lock-mode 1)))
- (set (make-local-variable 'facemenu-add-face-function)
- #'cperl-facemenu-add-face-function) ; XXXX What this guy is for???
+ (setq-local facemenu-add-face-function
+ #'cperl-facemenu-add-face-function) ; XXXX What this guy is for???
(and (boundp 'msb-menu-cond)
(not cperl-msb-fixed)
(cperl-msb-fix))
@@ -3478,49 +3473,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(font-lock-string-face (if (boundp 'font-lock-string-face)
font-lock-string-face
'font-lock-string-face))
- (my-cperl-delimiters-face (if (boundp 'font-lock-constant-face)
- font-lock-constant-face
- 'font-lock-constant-face))
+ (my-cperl-delimiters-face
+ font-lock-constant-face)
(my-cperl-REx-spec-char-face ; [] ^.$ and wrapper-of ({})
- (if (boundp 'font-lock-function-name-face)
- font-lock-function-name-face
- 'font-lock-function-name-face))
- (font-lock-variable-name-face ; interpolated vars and ({})-code
- (if (boundp 'font-lock-variable-name-face)
- font-lock-variable-name-face
- 'font-lock-variable-name-face))
- (font-lock-function-name-face ; used in `cperl-find-sub-attrs'
- (if (boundp 'font-lock-function-name-face)
- font-lock-function-name-face
- 'font-lock-function-name-face))
- (font-lock-constant-face ; used in `cperl-find-sub-attrs'
- (if (boundp 'font-lock-constant-face)
- font-lock-constant-face
- 'font-lock-constant-face))
+ font-lock-function-name-face)
(my-cperl-REx-0length-face ; 0-length, (?:)etc, non-literal \
- (if (boundp 'font-lock-builtin-face)
- font-lock-builtin-face
- 'font-lock-builtin-face))
- (font-lock-comment-face
- (if (boundp 'font-lock-comment-face)
- font-lock-comment-face
- 'font-lock-comment-face))
- (font-lock-warning-face
- (if (boundp 'font-lock-warning-face)
- font-lock-warning-face
- 'font-lock-warning-face))
+ font-lock-builtin-face)
(my-cperl-REx-ctl-face ; (|)
- (if (boundp 'font-lock-keyword-face)
- font-lock-keyword-face
- 'font-lock-keyword-face))
+ font-lock-keyword-face)
(my-cperl-REx-modifiers-face ; //gims
- (if (boundp 'cperl-nonoverridable-face)
- cperl-nonoverridable-face
- 'cperl-nonoverridable-face))
+ 'cperl-nonoverridable-face)
(my-cperl-REx-length1-face ; length=1 escaped chars, POSIX classes
- (if (boundp 'font-lock-type-face)
- font-lock-type-face
- 'font-lock-type-face))
+ font-lock-type-face)
(stop-point (if ignore-max
(point-max)
max))
@@ -6107,7 +6071,7 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
(set-buffer "*info-perl-tmp*")
(rename-buffer "*info*")
(set-buffer bname)))
- (set (make-local-variable 'window-min-height) 2)
+ (setq-local window-min-height 2)
(current-buffer)))))
(defun cperl-word-at-point (&optional p)
@@ -6425,7 +6389,7 @@ by CPerl."
(if cperl-use-syntax-table-text-property-for-tags
(progn
;; Do not introduce variable if not needed, we check it!
- (set (make-local-variable 'parse-sexp-lookup-properties) t))))
+ (setq-local parse-sexp-lookup-properties t))))
;; Copied from imenu-example--name-and-position.
(defvar imenu-use-markers)
@@ -8347,7 +8311,7 @@ may be used to debug problems with delayed incremental fontification."
(goto-char pos)
(normal-mode)
;; Why needed??? With older font-locks???
- (set (make-local-variable 'font-lock-cache-position) (make-marker))
+ (setq-local font-lock-cache-position (make-marker))
(while (if (> window-size 0)
(< pos (point-max))
(> pos (point-min)))
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index ca45795adc0..9bafd7aa42c 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -588,17 +588,17 @@ $
There is some minimal font-lock support (see vars
`dcl-font-lock-defaults' and `dcl-font-lock-keywords')."
- (set (make-local-variable 'indent-line-function) 'dcl-indent-line)
- (set (make-local-variable 'comment-start) "!")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-multi-line) nil)
+ (setq-local indent-line-function 'dcl-indent-line)
+ (setq-local comment-start "!")
+ (setq-local comment-end "")
+ (setq-local comment-multi-line nil)
;; This used to be "^\\$[ \t]*![ \t]*" which looks more correct.
;; The drawback was that you couldn't make empty comment lines by pressing
;; C-M-j repeatedly - only the first line became a comment line.
;; This version has the drawback that the "$" can be anywhere in the line,
;; and something inappropriate might be interpreted as a comment.
- (set (make-local-variable 'comment-start-skip) "\\$[ \t]*![ \t]*")
+ (setq-local comment-start-skip "\\$[ \t]*![ \t]*")
(if (boundp 'imenu-generic-expression)
(progn (setq imenu-generic-expression dcl-imenu-generic-expression)
@@ -619,7 +619,7 @@ There is some minimal font-lock support (see vars
(make-local-variable 'dcl-electric-reindent-regexps)
;; font lock
- (set (make-local-variable 'font-lock-defaults) dcl-font-lock-defaults)
+ (setq-local font-lock-defaults dcl-font-lock-defaults)
(tempo-use-tag-list 'dcl-tempo-tags))
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 12788eacf1b..b7e0c452288 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -38,9 +38,10 @@ It has `lisp-mode-abbrev-table' as its parent."
:parents (list lisp-mode-abbrev-table))
(defvar emacs-lisp-mode-syntax-table
- (let ((table (make-syntax-table lisp--mode-syntax-table)))
- (modify-syntax-entry ?\[ "(] " table)
- (modify-syntax-entry ?\] ")[ " table)
+ (let ((table (make-syntax-table lisp-data-mode-syntax-table)))
+ ;; These are redundant, now.
+ ;;(modify-syntax-entry ?\[ "(] " table)
+ ;;(modify-syntax-entry ?\] ")[ " table)
table)
"Syntax table used in `emacs-lisp-mode'.")
@@ -1826,12 +1827,9 @@ Runs in a batch-mode Emacs. Interactively use variable
(interactive (list buffer-file-name))
(let* ((file (or file
(car command-line-args-left)))
- (dummy-elc-file)
(byte-compile-log-buffer
(generate-new-buffer " *dummy-byte-compile-log-buffer*"))
- (byte-compile-dest-file-function
- (lambda (source)
- (setq dummy-elc-file (make-temp-file (file-name-nondirectory source)))))
+ (byte-compile-dest-file-function #'ignore)
(collected)
(byte-compile-log-warning-function
(lambda (string &optional position fill level)
@@ -1841,7 +1839,6 @@ Runs in a batch-mode Emacs. Interactively use variable
(unwind-protect
(byte-compile-file file)
(ignore-errors
- (delete-file dummy-elc-file)
(kill-buffer byte-compile-log-buffer)))
(prin1 :elisp-flymake-output-start)
(terpri)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 104d889b8be..aadfb8150cf 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -258,9 +258,9 @@ One argument, the tag info returned by `snarf-tag-function'.")
Return non-nil if it is a valid tags table, and
in that case, also make the tags table state variables
buffer-local and set them to nil."
- (set (make-local-variable 'tags-table-files) nil)
- (set (make-local-variable 'tags-completion-table) nil)
- (set (make-local-variable 'tags-included-tables) nil)
+ (setq-local tags-table-files nil)
+ (setq-local tags-completion-table nil)
+ (setq-local tags-included-tables nil)
;; We used to initialize find-tag-marker-ring and tags-location-ring
;; here, to new empty rings. But that is wrong, because those
;; are global.
@@ -1234,34 +1234,29 @@ error message."
"If `etags-verify-tags-table', make buffer-local format variables.
If current buffer is a valid etags TAGS file, then give it
buffer-local values of tags table format variables."
- (and (etags-verify-tags-table)
- ;; It is annoying to flash messages on the screen briefly,
- ;; and this message is not useful. -- rms
- ;; (message "%s is an `etags' TAGS file" buffer-file-name)
- (mapc (lambda (elt) (set (make-local-variable (car elt)) (cdr elt)))
- '((file-of-tag-function . etags-file-of-tag)
- (tags-table-files-function . etags-tags-table-files)
- (tags-completion-table-function . etags-tags-completion-table)
- (snarf-tag-function . etags-snarf-tag)
- (goto-tag-location-function . etags-goto-tag-location)
- (find-tag-regexp-search-function . re-search-forward)
- (find-tag-regexp-tag-order . (tag-re-match-p))
- (find-tag-regexp-next-line-after-failure-p . t)
- (find-tag-search-function . search-forward)
- (find-tag-tag-order . (tag-exact-file-name-match-p
- tag-file-name-match-p
- tag-exact-match-p
- tag-implicit-name-match-p
- tag-symbol-match-p
- tag-word-match-p
- tag-partial-file-name-match-p
- tag-any-match-p))
- (find-tag-next-line-after-failure-p . nil)
- (list-tags-function . etags-list-tags)
- (tags-apropos-function . etags-tags-apropos)
- (tags-included-tables-function . etags-tags-included-tables)
- (verify-tags-table-function . etags-verify-tags-table)
- ))))
+ (when (etags-verify-tags-table)
+ (setq-local file-of-tag-function 'etags-file-of-tag)
+ (setq-local tags-table-files-function 'etags-tags-table-files)
+ (setq-local tags-completion-table-function 'etags-tags-completion-table)
+ (setq-local snarf-tag-function 'etags-snarf-tag)
+ (setq-local goto-tag-location-function 'etags-goto-tag-location)
+ (setq-local find-tag-regexp-search-function 're-search-forward)
+ (setq-local find-tag-regexp-tag-order '(tag-re-match-p))
+ (setq-local find-tag-regexp-next-line-after-failure-p t)
+ (setq-local find-tag-search-function 'search-forward)
+ (setq-local find-tag-tag-order '(tag-exact-file-name-match-p
+ tag-file-name-match-p
+ tag-exact-match-p
+ tag-implicit-name-match-p
+ tag-symbol-match-p
+ tag-word-match-p
+ tag-partial-file-name-match-p
+ tag-any-match-p))
+ (setq-local find-tag-next-line-after-failure-p nil)
+ (setq-local list-tags-function 'etags-list-tags)
+ (setq-local tags-apropos-function 'etags-tags-apropos)
+ (setq-local tags-included-tables-function 'etags-tags-included-tables)
+ (setq-local verify-tags-table-function 'etags-verify-tags-table)))
(defun etags-verify-tags-table ()
"Return non-nil if the current buffer is a valid etags TAGS file."
@@ -1593,16 +1588,16 @@ hits the start of file."
"Return non-nil if current buffer is empty.
If empty, make buffer-local values of the tags table format variables
that do nothing."
- (and (zerop (buffer-size))
- (mapc (lambda (sym) (set (make-local-variable sym) 'ignore))
- '(tags-table-files-function
- tags-completion-table-function
- find-tag-regexp-search-function
- find-tag-search-function
- tags-apropos-function
- tags-included-tables-function))
- (set (make-local-variable 'verify-tags-table-function)
- (lambda () (zerop (buffer-size))))))
+ (when (zerop (buffer-size))
+ (setq-local tags-table-files-function #'ignore)
+ (setq-local tags-completion-table-function #'ignore)
+ (setq-local find-tag-regexp-search-function #'ignore)
+ (setq-local find-tag-search-function #'ignore)
+ (setq-local tags-apropos-function #'ignore)
+ (setq-local tags-included-tables-function #'ignore)
+ (setq-local verify-tags-table-function
+ (lambda () (zerop (buffer-size))))))
+
;; Match qualifier functions for tagnames.
;; These functions assume the etags file format defined in etc/ETAGS.EBNF.
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index bae2bb66403..cc7280921ad 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -197,7 +197,7 @@ command to find the next error. The buffer is also in `comint-mode' and
buffer-file-name))))
(require 'compile)
(save-some-buffers (not compilation-ask-about-save))
- (set (make-local-variable 'executable-command) command)
+ (setq-local executable-command command)
(let ((compilation-error-regexp-alist executable-error-regexp-alist))
(compilation-start command t (lambda (_x) "*interpretation*"))))
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index 1fbbc892c03..3c5c29bd8d9 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -1179,29 +1179,26 @@ Turning on F90 mode calls the value of the variable `f90-mode-hook'
with no args, if that value is non-nil."
:group 'f90
:abbrev-table f90-mode-abbrev-table
- (set (make-local-variable 'indent-line-function) 'f90-indent-line)
- (set (make-local-variable 'indent-region-function) 'f90-indent-region)
- (set (make-local-variable 'comment-start) "!")
- (set (make-local-variable 'comment-start-skip) "!+ *")
- (set (make-local-variable 'comment-indent-function) 'f90-comment-indent)
- (set (make-local-variable 'abbrev-all-caps) t)
- (set (make-local-variable 'normal-auto-fill-function) 'f90-do-auto-fill)
+ (setq-local indent-line-function #'f90-indent-line)
+ (setq-local indent-region-function #'f90-indent-region)
+ (setq-local comment-start "!")
+ (setq-local comment-start-skip "!+ *")
+ (setq-local comment-indent-function 'f90-comment-indent)
+ (setq-local abbrev-all-caps t)
+ (setq-local normal-auto-fill-function #'f90-do-auto-fill)
(setq indent-tabs-mode nil) ; auto buffer local
- (set (make-local-variable 'fill-paragraph-function) 'f90-fill-paragraph)
- (set (make-local-variable 'font-lock-defaults)
- '((f90-font-lock-keywords f90-font-lock-keywords-1
- f90-font-lock-keywords-2
- f90-font-lock-keywords-3
- f90-font-lock-keywords-4)
- nil t))
- (set (make-local-variable 'imenu-case-fold-search) t)
- (set (make-local-variable 'imenu-generic-expression)
- f90-imenu-generic-expression)
- (set (make-local-variable 'beginning-of-defun-function)
- 'f90-beginning-of-subprogram)
- (set (make-local-variable 'end-of-defun-function) 'f90-end-of-subprogram)
- (set (make-local-variable 'add-log-current-defun-function)
- #'f90-current-defun))
+ (setq-local fill-paragraph-function #'f90-fill-paragraph)
+ (setq-local font-lock-defaults
+ '((f90-font-lock-keywords f90-font-lock-keywords-1
+ f90-font-lock-keywords-2
+ f90-font-lock-keywords-3
+ f90-font-lock-keywords-4)
+ nil t))
+ (setq-local imenu-case-fold-search t)
+ (setq-local imenu-generic-expression f90-imenu-generic-expression)
+ (setq-local beginning-of-defun-function #'f90-beginning-of-subprogram)
+ (setq-local end-of-defun-function #'f90-end-of-subprogram)
+ (setq-local add-log-current-defun-function #'f90-current-defun))
;; Inline-functions.
diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el
index d1985b4f777..19cef855c54 100644
--- a/lisp/progmodes/flymake-cc.el
+++ b/lisp/progmodes/flymake-cc.el
@@ -50,7 +50,7 @@ SOURCE."
;; TODO: if you can understand it, use `compilation-mode's regexps
;; or even some of its machinery here.
;;
- ;; (set (make-local-variable 'compilation-locs)
+ ;; (setq-local compilation-locs
;; (make-hash-table :test 'equal :weakness 'value))
;; (compilation-parse-errors (point-min) (point-max)
;; 'gnu 'gcc-include)
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index d84c3795653..1142c323dc3 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -861,36 +861,34 @@ with no args, if that value is non-nil."
:group 'fortran
:syntax-table fortran-mode-syntax-table
:abbrev-table fortran-mode-abbrev-table
- (set (make-local-variable 'indent-line-function) 'fortran-indent-line)
- (set (make-local-variable 'indent-region-function)
+ (setq-local indent-line-function 'fortran-indent-line)
+ (setq-local indent-region-function
(lambda (start end)
(let (fortran-blink-matching-if ; avoid blinking delay
indent-region-function)
(indent-region start end nil))))
- (set (make-local-variable 'require-final-newline) mode-require-final-newline)
+ (setq-local require-final-newline mode-require-final-newline)
;; The syntax tables don't understand the column-0 comment-markers.
- (set (make-local-variable 'comment-use-syntax) nil)
- (set (make-local-variable 'comment-padding) "$$$")
- (set (make-local-variable 'comment-start) fortran-comment-line-start)
- (set (make-local-variable 'comment-start-skip)
+ (setq-local comment-use-syntax nil)
+ (setq-local comment-padding "$$$")
+ (setq-local comment-start fortran-comment-line-start)
+ (setq-local comment-start-skip
;; We can't reuse `fortran-comment-line-start-skip' directly because
;; it contains backrefs whereas we need submatch-1 to end at the
;; beginning of the comment delimiter.
;; (concat "\\(\\)\\(![ \t]*\\|" fortran-comment-line-start-skip "\\)")
"\\(\\)\\(?:^[CcDd*]\\|!\\)\\(?:\\([^ \t\n]\\)\\2+\\)?[ \t]*")
- (set (make-local-variable 'comment-indent-function) 'fortran-comment-indent)
- (set (make-local-variable 'comment-region-function) 'fortran-comment-region)
- (set (make-local-variable 'uncomment-region-function)
- 'fortran-uncomment-region)
- (set (make-local-variable 'comment-insert-comment-function)
- 'fortran-indent-comment)
- (set (make-local-variable 'abbrev-all-caps) t)
- (set (make-local-variable 'normal-auto-fill-function) 'fortran-auto-fill)
- (set (make-local-variable 'indent-tabs-mode) (fortran-analyze-file-format))
+ (setq-local comment-indent-function 'fortran-comment-indent)
+ (setq-local comment-region-function 'fortran-comment-region)
+ (setq-local uncomment-region-function 'fortran-uncomment-region)
+ (setq-local comment-insert-comment-function 'fortran-indent-comment)
+ (setq-local abbrev-all-caps t)
+ (setq-local normal-auto-fill-function 'fortran-auto-fill)
+ (setq-local indent-tabs-mode (fortran-analyze-file-format))
(setq mode-line-process '(indent-tabs-mode fortran-tab-mode-string))
- (set (make-local-variable 'fill-column) fortran-line-length)
- (set (make-local-variable 'fill-paragraph-function) 'fortran-fill-paragraph)
- (set (make-local-variable 'font-lock-defaults)
+ (setq-local fill-column fortran-line-length)
+ (setq-local fill-paragraph-function 'fortran-fill-paragraph)
+ (setq-local font-lock-defaults
'((fortran-font-lock-keywords
fortran-font-lock-keywords-1
fortran-font-lock-keywords-2
@@ -898,20 +896,19 @@ with no args, if that value is non-nil."
fortran-font-lock-keywords-4)
nil t ((?/ . "$/") ("_$" . "w"))
fortran-beginning-of-subprogram))
- (set (make-local-variable 'syntax-propertize-function)
+ (setq-local syntax-propertize-function
(fortran-make-syntax-propertize-function fortran-line-length))
- (set (make-local-variable 'imenu-case-fold-search) t)
- (set (make-local-variable 'imenu-generic-expression)
- fortran-imenu-generic-expression)
- (set (make-local-variable 'imenu-syntax-alist) '(("_$" . "w")))
- (set (make-local-variable 'beginning-of-defun-function)
- #'fortran-beginning-of-subprogram)
- (set (make-local-variable 'end-of-defun-function)
- #'fortran-end-of-subprogram)
- (set (make-local-variable 'add-log-current-defun-function)
- #'fortran-current-defun)
- (set (make-local-variable 'dabbrev-case-fold-search) 'case-fold-search)
- (set (make-local-variable 'gud-find-expr-function) 'fortran-gud-find-expr)
+ (setq-local imenu-case-fold-search t)
+ (setq-local imenu-generic-expression fortran-imenu-generic-expression)
+ (setq-local imenu-syntax-alist '(("_$" . "w")))
+ (setq-local beginning-of-defun-function
+ #'fortran-beginning-of-subprogram)
+ (setq-local end-of-defun-function
+ #'fortran-end-of-subprogram)
+ (setq-local add-log-current-defun-function
+ #'fortran-current-defun)
+ (setq-local dabbrev-case-fold-search 'case-fold-search)
+ (setq-local gud-find-expr-function 'fortran-gud-find-expr)
(add-hook 'hack-local-variables-hook 'fortran-hack-local-variables nil t))
@@ -1221,25 +1218,32 @@ Auto-indent does not happen if a numeric ARG is used."
;; Note that unlike the latter, we don't have to worry about nested
;; subprograms (?).
;; FIXME push-mark?
-(defun fortran-beginning-of-subprogram ()
- "Move point to the beginning of the current Fortran subprogram."
+(defun fortran-beginning-of-subprogram (&optional arg)
+ "Move point to the beginning of the current Fortran subprogram.
+If ARG is negative, and point is between subprograms, the
+\"current\" subprogram is the next one."
(interactive)
- (let ((case-fold-search t))
- ;; If called already at the start of subprogram, go to the previous.
- (beginning-of-line (if (bolp) 0 1))
- (save-match-data
- (or (looking-at fortran-start-prog-re)
- ;; This leaves us at bob if before the first subprogram.
- (eq (fortran-previous-statement) 'first-statement)
- (if (or (catch 'ok
- (while (re-search-backward fortran-end-prog-re nil 'move)
- (if (fortran-check-end-prog-re) (throw 'ok t))))
- ;; If the search failed, must be at bob.
- ;; First code line is the start of the subprogram.
- ;; FIXME use a more rigorous test, cf fortran-next-statement?
- ;; Though that needs to handle continuations too.
- (not (looking-at "^\\([ \t]*[0-9]\\|[ \t]+[^!#]\\)")))
- (fortran-next-statement))))))
+ (if (and arg
+ (< arg 0))
+ (progn
+ (fortran-end-of-subprogram)
+ (fortran-beginning-of-subprogram))
+ (let ((case-fold-search t))
+ ;; If called already at the start of subprogram, go to the previous.
+ (beginning-of-line (if (bolp) 0 1))
+ (save-match-data
+ (or (looking-at fortran-start-prog-re)
+ ;; This leaves us at bob if before the first subprogram.
+ (eq (fortran-previous-statement) 'first-statement)
+ (if (or (catch 'ok
+ (while (re-search-backward fortran-end-prog-re nil 'move)
+ (if (fortran-check-end-prog-re) (throw 'ok t))))
+ ;; If the search failed, must be at bob.
+ ;; First code line is the start of the subprogram.
+ ;; FIXME use a more rigorous test, cf fortran-next-statement?
+ ;; Though that needs to handle continuations too.
+ (not (looking-at "^\\([ \t]*[0-9]\\|[ \t]+[^!#]\\)")))
+ (fortran-next-statement)))))))
;; This is simpler than f-beginning-of-s because the end of a
;; subprogram is never implicit.
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 903005610d7..4c248f771cd 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -744,7 +744,7 @@ NOARG must be t when this macro is used outside `gud-def'."
;; Use the old gud-gbd filter, not because it works, but because it
;; will properly display GDB's answers rather than hanging waiting for
;; answers that aren't coming.
- (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
+ (setq-local gud-marker-filter #'gud-gdb-marker-filter))
(funcall filter proc string)))
(defvar gdb-control-level 0)
@@ -831,8 +831,8 @@ detailed description of this mode.
(let ((proc (get-buffer-process gud-comint-buffer)))
(add-function :around (process-filter proc) #'gdb--check-interpreter))
- (set (make-local-variable 'gud-minor-mode) 'gdbmi)
- (set (make-local-variable 'gdb-control-level) 0)
+ (setq-local gud-minor-mode 'gdbmi)
+ (setq-local gdb-control-level 0)
(setq comint-input-sender 'gdb-send)
(when (ring-empty-p comint-input-ring) ; cf shell-mode
(let ((hfile (expand-file-name (or (getenv "GDBHISTFILE")
@@ -861,9 +861,9 @@ detailed description of this mode.
(and (stringp hsize)
(integerp (setq hsize (string-to-number hsize)))
(> hsize 0)
- (set (make-local-variable 'comint-input-ring-size) hsize))
+ (setq-local comint-input-ring-size hsize))
(if (stringp hfile)
- (set (make-local-variable 'comint-input-ring-file-name) hfile))
+ (setq-local comint-input-ring-file-name hfile))
(comint-read-input-ring t)))
(gud-def gud-tbreak "tbreak %f:%l" "\C-t"
"Set temporary breakpoint at current line.")
@@ -966,8 +966,7 @@ detailed description of this mode.
(define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
- (set (make-local-variable 'gud-gdb-completion-function)
- 'gud-gdbmi-completions)
+ (setq-local gud-gdb-completion-function 'gud-gdbmi-completions)
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
@@ -1141,8 +1140,8 @@ no input, and GDB is waiting for input."
(lambda () (gdb-tooltip-print expr)))))))
(defun gdb-init-buffer ()
- (set (make-local-variable 'gud-minor-mode) 'gdbmi)
- (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
+ (setq-local gud-minor-mode 'gdbmi)
+ (setq-local tool-bar-map gud-tool-bar-map)
(when gud-tooltip-mode
(make-local-variable 'gdb-define-alist)
(gdb-create-define-alist)
@@ -1558,10 +1557,10 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
(when mode (funcall mode))
(setq gdb-buffer-type buffer-type)
(when thread
- (set (make-local-variable 'gdb-thread-number) thread))
- (set (make-local-variable 'gud-minor-mode)
- (buffer-local-value 'gud-minor-mode gud-comint-buffer))
- (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
+ (setq-local gdb-thread-number thread))
+ (setq-local gud-minor-mode
+ (buffer-local-value 'gud-minor-mode gud-comint-buffer))
+ (setq-local tool-bar-map gud-tool-bar-map)
(rename-buffer (funcall (gdb-rules-name-maker rules)))
(when trigger
(gdb-add-subscriber gdb-buf-publisher
@@ -3364,8 +3363,7 @@ corresponding to the mode line clicked."
(setq gdb-thread-position (make-marker))
(add-to-list 'overlay-arrow-variable-list 'gdb-thread-position)
(setq header-line-format gdb-threads-header)
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-threads-font-lock-keywords))
+ (setq-local font-lock-defaults '(gdb-threads-font-lock-keywords))
'gdb-invalidate-threads)
(defun gdb-thread-list-handler-custom ()
@@ -3920,8 +3918,7 @@ DOC is an optional documentation string."
(define-derived-mode gdb-memory-mode gdb-parent-mode "Memory"
"Major mode for examining memory."
(setq header-line-format gdb-memory-header)
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-memory-font-lock-keywords))
+ (setq-local font-lock-defaults '(gdb-memory-font-lock-keywords))
'gdb-invalidate-memory)
(defun gdb-memory-buffer-name ()
@@ -4013,9 +4010,8 @@ DOC is an optional documentation string."
;; TODO Rename overlay variable for disassembly mode
(add-to-list 'overlay-arrow-variable-list 'gdb-disassembly-position)
(setq fringes-outside-margins t)
- (set (make-local-variable 'gdb-disassembly-position) (make-marker))
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-disassembly-font-lock-keywords))
+ (setq-local gdb-disassembly-position (make-marker))
+ (setq-local font-lock-defaults '(gdb-disassembly-font-lock-keywords))
'gdb-invalidate-disassembly)
(defun gdb-disassembly-handler-custom ()
@@ -4222,8 +4218,7 @@ member."
(setq gdb-stack-position (make-marker))
(add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
(setq truncate-lines t) ;; Make it easier to see overlay arrow.
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-frames-font-lock-keywords))
+ (setq-local font-lock-defaults '(gdb-frames-font-lock-keywords))
'gdb-invalidate-frames)
(defun gdb-select-frame (&optional event)
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index dafba22f777..5dc99cc7e93 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -100,7 +100,7 @@ To change the default value, use \\[customize] or call the function
:set #'grep-apply-setting
:version "22.1")
-(defcustom grep-match-regexp "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m"
+(defcustom grep-match-regexp "\033\\[\\(?:0?1;\\)?31m\\(.*?\\)\033\\[[0-9]*m"
"Regular expression matching grep markers to highlight.
It matches SGR ANSI escape sequences which are emitted by grep to
color its output. This variable is used in `grep-filter'."
@@ -412,7 +412,7 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
(- mend beg))))))
nil nil
(3 '(face nil display ":")))
- ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
+ ("^Binary file \\(.+\\) matches" 1 nil nil 0 1))
"Regexp used to match grep hits.
See `compilation-error-regexp-alist' for format details.")
@@ -568,8 +568,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
;; GREP_COLORS is used in GNU grep 2.5.2 and later versions
(setenv "GREP_COLORS" "mt=01;31:fn=:ln=:bn=:se=:sl=:cx=:ne"))
(setq-local grep-num-matches-found 0)
- (set (make-local-variable 'compilation-exit-message-function)
- #'grep-exit-message)
+ (setq-local compilation-exit-message-function #'grep-exit-message)
(run-hooks 'grep-setup-hook))
(defun grep-exit-message (status code msg)
@@ -880,22 +879,22 @@ The value depends on `grep-command', `grep-template',
(define-compilation-mode grep-mode "Grep"
"Sets `grep-last-buffer' and `compilation-window-height'."
(setq grep-last-buffer (current-buffer))
- (set (make-local-variable 'tool-bar-map) grep-mode-tool-bar-map)
- (set (make-local-variable 'compilation-error-face)
- grep-hit-face)
- (set (make-local-variable 'compilation-error-regexp-alist)
- grep-regexp-alist)
- (set (make-local-variable 'compilation-mode-line-errors)
- grep-mode-line-matches)
+ (setq-local tool-bar-map grep-mode-tool-bar-map)
+ (setq-local compilation-error-face
+ grep-hit-face)
+ (setq-local compilation-error-regexp-alist
+ grep-regexp-alist)
+ (setq-local compilation-mode-line-errors
+ grep-mode-line-matches)
;; compilation-directory-matcher can't be nil, so we set it to a regexp that
;; can never match.
- (set (make-local-variable 'compilation-directory-matcher)
- (list regexp-unmatchable))
- (set (make-local-variable 'compilation-process-setup-function)
- #'grep-process-setup)
- (set (make-local-variable 'compilation-disable-input) t)
- (set (make-local-variable 'compilation-error-screen-columns)
- grep-error-screen-columns)
+ (setq-local compilation-directory-matcher
+ (list regexp-unmatchable))
+ (setq-local compilation-process-setup-function
+ #'grep-process-setup)
+ (setq-local compilation-disable-input t)
+ (setq-local compilation-error-screen-columns
+ grep-error-screen-columns)
(add-hook 'compilation-filter-hook #'grep-filter nil t))
(defun grep--save-buffers ()
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 81021bc64f4..134c2fc5c97 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -758,7 +758,7 @@ the buffer in which this command was invoked."
"Multiple debugging requires restarting in text command mode"))
(gud-common-init command-line nil 'gud-gdb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'gdb)
+ (setq-local gud-minor-mode 'gdb)
(gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-tbreak "tbreak %f:%l" "\C-t"
@@ -788,7 +788,7 @@ the buffer in which this command was invoked."
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
- (set (make-local-variable 'gud-gdb-completion-function) 'gud-gdb-completions)
+ (setq-local gud-gdb-completion-function 'gud-gdb-completions)
(local-set-key "\C-i" 'completion-at-point)
(setq comint-prompt-regexp "^(.*gdb[+]?) *")
@@ -1044,7 +1044,7 @@ and source-file directory for your debugger."
(error "The sdb support requires a valid tags table to work"))
(gud-common-init command-line nil 'gud-sdb-marker-filter 'gud-sdb-find-file)
- (set (make-local-variable 'gud-minor-mode) 'sdb)
+ (setq-local gud-minor-mode 'sdb)
(gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.")
(gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.")
@@ -1323,7 +1323,7 @@ and source-file directory for your debugger."
(gud-common-init command-line 'gud-dbx-massage-args
'gud-dbx-marker-filter)))
- (set (make-local-variable 'gud-minor-mode) 'dbx)
+ (setq-local gud-minor-mode 'dbx)
(cond
(gud-mips-p
@@ -1424,7 +1424,7 @@ directories if your program contains sources from more than one directory."
(gud-common-init command-line 'gud-xdb-massage-args
'gud-xdb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'xdb)
+ (setq-local gud-minor-mode 'xdb)
(gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-tbreak "b %f:%l\\t" "\C-t"
@@ -1578,7 +1578,7 @@ and source-file directory for your debugger."
(gud-common-init command-line 'gud-perldb-massage-args
'gud-perldb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'perldb)
+ (setq-local gud-minor-mode 'perldb)
(gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-remove "B %l" "\C-d" "Remove breakpoint at current line")
@@ -1683,7 +1683,7 @@ and source-file directory for your debugger."
;;;###autoload
(defun pdb (command-line)
- "Run COMMAND-LINE in the `*gud-FILE*' buffer.
+ "Run COMMAND-LINE in the `*gud-FILE*' buffer to debug Python programs.
COMMAND-LINE should include the pdb executable
name (`gud-pdb-command-name') and the file to be debugged.
@@ -1696,7 +1696,7 @@ directory and source-file directory for your debugger."
(list (gud-query-cmdline 'pdb)))
(gud-common-init command-line nil 'gud-pdb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'pdb)
+ (setq-local gud-minor-mode 'pdb)
(gud-def gud-break "break %d%f:%l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-remove "clear %d%f:%l" "\C-d" "Remove breakpoint at current line")
@@ -2418,7 +2418,7 @@ gud, see `gud-mode'."
(gud-common-init command-line 'gud-jdb-massage-args
'gud-jdb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'jdb)
+ (setq-local gud-minor-mode 'jdb)
;; If a -classpath option was provided, set gud-jdb-classpath
(if gud-jdb-classpath-string
@@ -2566,17 +2566,21 @@ You may use the `gud-def' macro in the initialization hook to define other
commands.
Other commands for interacting with the debugger process are inherited from
-comint mode, which see."
+`comint-mode', which see.
+
+Commands:
+
+\\{gud-mode-map}"
(setq mode-line-process '(":%s"))
(define-key (current-local-map) "\C-c\C-l" 'gud-refresh)
- (set (make-local-variable 'gud-last-frame) nil)
+ (setq-local gud-last-frame nil)
(if (boundp 'tool-bar-map) ; not --without-x
(setq-local tool-bar-map gud-tool-bar-map))
(make-local-variable 'comint-prompt-regexp)
;; Don't put repeated commands in command history many times.
- (set (make-local-variable 'comint-input-ignoredups) t)
+ (setq-local comint-input-ignoredups t)
(make-local-variable 'paragraph-start)
- (set (make-local-variable 'gud-delete-prompt-marker) (make-marker))
+ (setq-local gud-delete-prompt-marker (make-marker))
(add-hook 'kill-buffer-hook 'gud-kill-buffer-hook nil t))
(defcustom gud-chdir-before-run t
@@ -2649,10 +2653,10 @@ comint mode, which see."
(if massage-args (funcall massage-args file args) args))
;; Since comint clobbered the mode, we don't set it until now.
(gud-mode)
- (set (make-local-variable 'gud-target-name)
+ (setq-local gud-target-name
(and file-word (file-name-nondirectory file))))
- (set (make-local-variable 'gud-marker-filter) marker-filter)
- (if find-file (set (make-local-variable 'gud-find-file) find-file))
+ (setq-local gud-marker-filter marker-filter)
+ (if find-file (setq-local gud-find-file find-file))
(setq gud-last-last-frame nil)
(set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
@@ -3348,23 +3352,23 @@ Treats actions as defuns."
;;;###autoload
(define-derived-mode gdb-script-mode prog-mode "GDB-Script"
"Major mode for editing GDB scripts."
- (set (make-local-variable 'comment-start) "#")
- (set (make-local-variable 'comment-start-skip) "#+\\s-*")
- (set (make-local-variable 'outline-regexp) "[ \t]")
- (set (make-local-variable 'imenu-generic-expression)
- '((nil "^define[ \t]+\\(\\w+\\)" 1)))
- (set (make-local-variable 'indent-line-function) 'gdb-script-indent-line)
- (set (make-local-variable 'beginning-of-defun-function)
- #'gdb-script-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
- #'gdb-script-end-of-defun)
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
- (font-lock-syntactic-face-function
- . gdb-script-font-lock-syntactic-face)))
+ (setq-local comment-start "#")
+ (setq-local comment-start-skip "#+\\s-*")
+ (setq-local outline-regexp "[ \t]")
+ (setq-local imenu-generic-expression
+ '((nil "^define[ \t]+\\(\\w+\\)" 1)))
+ (setq-local indent-line-function 'gdb-script-indent-line)
+ (setq-local beginning-of-defun-function
+ #'gdb-script-beginning-of-defun)
+ (setq-local end-of-defun-function
+ #'gdb-script-end-of-defun)
+ (setq-local font-lock-defaults
+ '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
+ (font-lock-syntactic-face-function
+ . gdb-script-font-lock-syntactic-face)))
;; Recognize docstrings.
- (set (make-local-variable 'syntax-propertize-function)
- gdb-script-syntax-propertize-function)
+ (setq-local syntax-propertize-function
+ gdb-script-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local))
@@ -3471,8 +3475,8 @@ only tooltips in the buffer containing the overlay arrow."
ACTIVATEP non-nil means activate mouse motion events."
(if activatep
(progn
- (set (make-local-variable 'gud-tooltip-mouse-motions-active) t)
- (set (make-local-variable 'track-mouse) t))
+ (setq-local gud-tooltip-mouse-motions-active t)
+ (setq-local track-mouse t))
(when gud-tooltip-mouse-motions-active
(kill-local-variable 'gud-tooltip-mouse-motions-active)
(kill-local-variable 'track-mouse))))
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 25e75235aa4..7cbc9708fce 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -302,17 +302,17 @@ Several variables affect how the hiding is done:
;; We can still simulate the behavior of older hideif versions (i.e.
;; `hide-ifdef-env' being buffer local) by clearing this variable
;; (C-c @ C) every time before hiding current buffer.
-;; (set (make-local-variable 'hide-ifdef-env)
+;; (setq-local hide-ifdef-env
;; (default-value 'hide-ifdef-env))
(set 'hide-ifdef-env (default-value 'hide-ifdef-env))
;; Some C/C++ headers might have other ways to prevent reinclusion and
;; thus would like `hide-ifdef-expand-reinclusion-protection' to be nil.
- (set (make-local-variable 'hide-ifdef-expand-reinclusion-protection)
- (default-value 'hide-ifdef-expand-reinclusion-protection))
- (set (make-local-variable 'hide-ifdef-hiding)
- (default-value 'hide-ifdef-hiding))
- (set (make-local-variable 'hif-outside-read-only) buffer-read-only)
- (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq-local hide-ifdef-expand-reinclusion-protection
+ (default-value 'hide-ifdef-expand-reinclusion-protection))
+ (setq-local hide-ifdef-hiding
+ (default-value 'hide-ifdef-hiding))
+ (setq-local hif-outside-read-only buffer-read-only)
+ (setq-local line-move-ignore-invisible t)
(add-hook 'change-major-mode-hook
(lambda () (hide-ifdef-mode -1)) nil t)
@@ -1792,7 +1792,7 @@ It does not do the work that's pointless to redo on a recursive entry."
(defun hide-ifdef-toggle-shadowing ()
"Toggle shadowing."
(interactive)
- (set (make-local-variable 'hide-ifdef-shadow) (not hide-ifdef-shadow))
+ (setq-local hide-ifdef-shadow (not hide-ifdef-shadow))
(message "Shadowing %s" (if hide-ifdef-shadow "ON" "OFF"))
(save-restriction
(widen)
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 4dee72c737d..c882b7bc52c 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -948,7 +948,7 @@ Key bindings:
(add-hook 'change-major-mode-hook
#'turn-off-hideshow
nil t)
- (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq-local line-move-ignore-invisible t)
(add-to-invisibility-spec '(hs . t)))
(remove-from-invisibility-spec '(hs . t))
;; hs-show-all does nothing unless h-m-m is non-nil.
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
index bb43215c33e..dd0ee952a26 100644
--- a/lisp/progmodes/icon.el
+++ b/lisp/progmodes/icon.el
@@ -163,25 +163,24 @@ Variables controlling indentation style:
Turning on Icon mode calls the value of the variable `icon-mode-hook'
with no args, if that value is non-nil."
:abbrev-table icon-mode-abbrev-table
- (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'indent-line-function) #'icon-indent-line)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-start-skip) "# *")
- (set (make-local-variable 'comment-indent-function) 'icon-comment-indent)
- (set (make-local-variable 'indent-line-function) 'icon-indent-line)
+ (setq-local paragraph-start (concat "$\\|" page-delimiter))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local indent-line-function #'icon-indent-line)
+ (setq-local comment-start "# ")
+ (setq-local comment-end "")
+ (setq-local comment-start-skip "# *")
+ (setq-local comment-indent-function 'icon-comment-indent)
+ (setq-local indent-line-function 'icon-indent-line)
;; font-lock support
- (set (make-local-variable 'font-lock-defaults)
- '((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)))
+ (setq-local font-lock-defaults
+ '((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
- (set (make-local-variable 'imenu-generic-expression)
- icon-imenu-generic-expression)
+ (setq-local imenu-generic-expression icon-imenu-generic-expression)
;; hideshow support
;; we start from the assertion that `hs-special-modes-alist' is autoloaded.
(unless (assq 'icon-mode hs-special-modes-alist)
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index 59db646ff32..93d5d0fbcc2 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -124,9 +124,9 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
(define-key lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)
-;;; This function exists for backwards compatibility.
-;;; Previous versions of this package bound commands to C-c
-;;; bindings, which is not allowed by the Emacs standard.
+;; This function exists for backwards compatibility.
+;; Previous versions of this package bound commands to C-c
+;; bindings, which is not allowed by the Emacs standard.
;;; "This function binds many inferior-lisp commands to C-c bindings,
;;;where they are more accessible. C-c bindings are reserved for the
@@ -274,7 +274,8 @@ If you accidentally suspend your process, use \\[comint-continue-subjob]
to continue it."
(setq comint-prompt-regexp inferior-lisp-prompt)
(setq mode-line-process '(":%s"))
- (lisp-mode-variables t)
+ (lisp-mode-variables)
+ (set-syntax-table lisp-mode-syntax-table)
(setq comint-get-old-input (function lisp-get-old-input))
(setq comint-input-filter (function lisp-input-filter)))
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index b17f255ba6a..656af69d42b 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -173,10 +173,9 @@
;;;###autoload
(define-derived-mode ld-script-mode prog-mode "LD-Script"
"A major mode to edit GNU ld script files"
- (set (make-local-variable 'comment-start) "/* ")
- (set (make-local-variable 'comment-end) " */")
- (set (make-local-variable 'font-lock-defaults)
- '(ld-script-font-lock-keywords nil)))
+ (setq-local comment-start "/* ")
+ (setq-local comment-end " */")
+ (setq-local font-lock-defaults '(ld-script-font-lock-keywords nil)))
(provide 'ld-script)
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 3e49f84dbce..8b6a7fc1b48 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -343,8 +343,9 @@ not be enclosed in { } or ( )."
"List of keywords understood by gmake.")
(defconst makefile-bsdmake-statements
- '(".elif" ".elifdef" ".elifmake" ".elifndef" ".elifnmake" ".else" ".endfor"
- ".endif" ".for" ".if" ".ifdef" ".ifmake" ".ifndef" ".ifnmake" ".undef")
+ '("elif" "elifdef" "elifmake" "elifndef" "elifnmake" "else" "endfor"
+ "endif" "for" "if" "ifdef" "ifmake" "ifndef" "ifnmake" "poison"
+ "undef" "include")
"List of keywords understood by BSD make.")
(defun makefile-make-font-lock-keywords (var keywords space
@@ -376,8 +377,9 @@ not be enclosed in { } or ( )."
("[^$]\\(\\$[@%*]\\)"
1 'makefile-targets append)
- ;; Fontify conditionals and includes.
- (,(concat "^\\(?: [ \t]*\\)?"
+ ,@(if keywords
+ ;; Fontify conditionals and includes.
+ `((,(concat "^\\(?: [ \t]*\\)?"
(replace-regexp-in-string
" " "[ \t]+"
(if (eq (car keywords) t)
@@ -385,7 +387,7 @@ not be enclosed in { } or ( )."
(regexp-opt (cdr keywords) t))
(regexp-opt keywords t)))
"\\>[ \t]*\\([^: \t\n#]*\\)")
- (1 font-lock-keyword-face) (2 font-lock-variable-name-face))
+ (1 font-lock-keyword-face) (2 font-lock-variable-name-face))))
,@(if negation
`((,negation (1 font-lock-negation-char-face prepend)
@@ -493,13 +495,17 @@ not be enclosed in { } or ( )."
1 'makefile-makepp-perl t)))
(defconst makefile-bsdmake-font-lock-keywords
- (makefile-make-font-lock-keywords
- ;; A lot more could be done for variables here:
- makefile-var-use-regex
- makefile-bsdmake-statements
- t
- "^\\(?: [ \t]*\\)?\\.\\(?:el\\)?if\\(n?\\)\\(?:def\\|make\\)?\\>[ \t]*\\(!?\\)"
- '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face)))
+ (append
+ (makefile-make-font-lock-keywords
+ ;; A lot more could be done for variables here:
+ makefile-var-use-regex
+ nil
+ t
+ "^\\(?: [ \t]*\\)?\\.\\(?:el\\)?if\\(n?\\)\\(?:def\\|make\\)?\\>[ \t]*\\(!?\\)"
+ '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face))
+ `((,(concat "^\\. *" (regexp-opt makefile-bsdmake-statements) "\\>") 0
+ font-lock-keyword-face))))
+
(defconst makefile-imake-font-lock-keywords
(append
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 87c20a2ee0e..e15ec721814 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -919,57 +919,55 @@ The environment marked is the one that contains point or follows point."
(define-derived-mode meta-common-mode prog-mode "-Meta-common-"
"Common initialization for Metafont or MetaPost mode."
:abbrev-table meta-mode-abbrev-table
- (set (make-local-variable 'paragraph-start)
- (concat page-delimiter "\\|$"))
- (set (make-local-variable 'paragraph-separate)
- (concat page-delimiter "\\|$"))
+ (setq-local paragraph-start (concat page-delimiter "\\|$"))
+ (setq-local paragraph-separate (concat page-delimiter "\\|$"))
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
+ (setq-local paragraph-ignore-fill-prefix t)
- (set (make-local-variable 'comment-start-skip) "%+[ \t\f]*")
- (set (make-local-variable 'comment-start) "%")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-multi-line) nil)
+ (setq-local comment-start-skip "%+[ \t\f]*")
+ (setq-local comment-start "%")
+ (setq-local comment-end "")
+ (setq-local comment-multi-line nil)
;; We use `back-to-indentation' but \f is no indentation sign.
(modify-syntax-entry ?\f "_ ")
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (setq-local parse-sexp-ignore-comments t)
(add-hook 'completion-at-point-functions #'meta-completions-at-point nil t)
- (set (make-local-variable 'comment-indent-function) #'meta-comment-indent)
- (set (make-local-variable 'indent-line-function) #'meta-indent-line)
+ (setq-local comment-indent-function #'meta-comment-indent)
+ (setq-local indent-line-function #'meta-indent-line)
;; No need to define a mode-specific 'indent-region-function.
;; Simply use the generic 'indent-region and 'comment-region.
;; Set defaults for font-lock mode.
- (set (make-local-variable 'font-lock-defaults)
- '(meta-font-lock-keywords
- nil nil ((?_ . "w")) nil
- (font-lock-comment-start-regexp . "%"))))
+ (setq-local font-lock-defaults
+ '(meta-font-lock-keywords
+ nil nil ((?_ . "w")) nil
+ (font-lock-comment-start-regexp . "%"))))
;;;###autoload
(define-derived-mode metafont-mode meta-common-mode "Metafont"
"Major mode for editing Metafont sources."
;; Set defaults for completion function.
- (set (make-local-variable 'meta-symbol-list) nil)
- (set (make-local-variable 'meta-symbol-changed) nil)
+ (setq-local meta-symbol-list nil)
+ (setq-local meta-symbol-changed nil)
(apply 'meta-add-symbols metafont-symbol-list)
- (set (make-local-variable 'meta-complete-list)
- (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
- (list "" 'ispell-complete-word))))
+ (setq-local meta-complete-list
+ (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
+ (list "" 'ispell-complete-word))))
;;;###autoload
(define-derived-mode metapost-mode meta-common-mode "MetaPost"
"Major mode for editing MetaPost sources."
;; Set defaults for completion function.
- (set (make-local-variable 'meta-symbol-list) nil)
- (set (make-local-variable 'meta-symbol-changed) nil)
+ (setq-local meta-symbol-list nil)
+ (setq-local meta-symbol-changed nil)
(apply 'meta-add-symbols metapost-symbol-list)
- (set (make-local-variable 'meta-complete-list)
- (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
- (list "" 'ispell-complete-word))))
+ (setq-local meta-complete-list
+ (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
+ (list "" 'ispell-complete-word))))
;;; Just in case ...
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index b9f60598f63..1f88e87c651 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -1141,18 +1141,18 @@ Assumes that file has been compiled with debugging support."
;;;###autoload
(define-derived-mode mixal-mode prog-mode "mixal"
"Major mode for the mixal asm language."
- (set (make-local-variable 'comment-start) "*")
- (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*")
- (set (make-local-variable 'font-lock-defaults)
- '(mixal-font-lock-keywords))
- (set (make-local-variable 'syntax-propertize-function)
- mixal-syntax-propertize-function)
+ (setq-local comment-start "*")
+ (setq-local comment-start-skip "^\\*[ \t]*")
+ (setq-local font-lock-defaults
+ '(mixal-font-lock-keywords))
+ (setq-local syntax-propertize-function
+ mixal-syntax-propertize-function)
;; might add an indent function in the future
- ;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line)
- (set (make-local-variable 'compile-command)
- (concat "mixasm "
- (if buffer-file-name
- (shell-quote-argument buffer-file-name)))))
+ ;; (setq-local indent-line-function 'mixal-indent-line)
+ (setq-local compile-command
+ (concat "mixasm "
+ (if buffer-file-name
+ (shell-quote-argument buffer-file-name)))))
(provide 'mixal-mode)
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index aa412304c59..a77a4e2b216 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -308,14 +308,14 @@ followed by the first character of the construct.
`m2-indent' controls the number of spaces for each indentation.
`m2-compile-command' holds the command to compile a Modula-2 program.
`m2-link-command' holds the command to link a Modula-2 program."
- (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
- (set (make-local-variable 'comment-start) "(* ")
- (set (make-local-variable 'comment-end) " *)")
- (set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *")
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'font-lock-defaults)
+ (setq-local paragraph-start (concat "$\\|" page-delimiter))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local paragraph-ignore-fill-prefix t)
+ (setq-local comment-start "(* ")
+ (setq-local comment-end " *)")
+ (setq-local comment-start-skip "\\(?:(\\*+\\|//+\\) *")
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local font-lock-defaults
'((m3-font-lock-keywords
m3-font-lock-keywords-1 m3-font-lock-keywords-2)
nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index bb19436cdad..fd8a51b5a54 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -299,12 +299,21 @@
;; $a = "foo y \"toto\" bar" where we'd end up changing the
;; syntax of the backslash and hence de-escaping the embedded
;; double quote.
- (put-text-property (match-beginning 3) (match-end 3)
- 'syntax-table
- (if (assoc (char-after (match-beginning 3))
- perl-quote-like-pairs)
- (string-to-syntax "|")
- (string-to-syntax "\"")))
+ (let* ((b3 (match-beginning 3))
+ (c (char-after b3)))
+ (put-text-property
+ b3 (match-end 3) 'syntax-table
+ (cond
+ ((assoc c perl-quote-like-pairs)
+ (string-to-syntax "|"))
+ ;; If the separator is a normal quote and the operation
+ ;; only takes a single arg, then there's nothing
+ ;; special to do.
+ ((and (memq c '(?\" ?\'))
+ (memq (char-after (match-beginning 2)) '(?m ?q)))
+ nil)
+ (t
+ (string-to-syntax "\"")))))
(perl-syntax-propertize-special-constructs end))))))
;; Here documents.
((concat
@@ -379,7 +388,8 @@
(put-text-property (1- (point)) (point) 'syntax-table
(string-to-syntax "> c"))))))
((or (null (setq char (nth 3 state)))
- (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
+ (and (characterp char)
+ (null (get-text-property (nth 8 state) 'syntax-table))))
;; Normal text, or comment, or docstring, or normal string.
nil)
((eq (nth 3 state) ?\n)
@@ -400,6 +410,7 @@
(point)))
'("tr" "s" "y"))))
(close (cdr (assq char perl-quote-like-pairs)))
+ (middle nil)
(st (perl-quote-syntax-table char)))
(when (with-syntax-table st
(if close
@@ -430,6 +441,7 @@
;; In the case of s{...}{...}, we only handle the
;; first part here and the next below.
(when (and twoargs (not close))
+ (setq middle (point))
(nth 8 (parse-partial-sexp
(point) limit
nil nil state 'syntax-table)))))))
@@ -437,11 +449,14 @@
(when (eq (char-before (1- (point))) ?$)
(put-text-property (- (point) 2) (1- (point))
'syntax-table '(1)))
- (put-text-property (1- (point)) (point)
- 'syntax-table
- (if close
- (string-to-syntax "|")
- (string-to-syntax "\"")))
+ (if (and middle (memq char '(?\" ?\')))
+ (put-text-property (1- middle) middle
+ 'syntax-table '(1))
+ (put-text-property (1- (point)) (point)
+ 'syntax-table
+ (if close
+ (string-to-syntax "|")
+ (string-to-syntax "\""))))
;; If we have two args with a non-self-paired starter (e.g.
;; s{...}{...}) we're right after the first arg, so we still have to
;; handle the second part.
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 449eadc3de7..0ed5f1f907c 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
-;; Version: 0.5.2
+;; Version: 0.5.3
;; Package-Requires: ((emacs "26.3") (xref "1.0.2"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -1275,13 +1275,15 @@ the menu entries in the dispatch menu.")
" "))
;;;###autoload
-(defun project-switch-project ()
+(defun project-switch-project (dir)
"\"Switch\" to another project by running an Emacs command.
The available commands are presented as a dispatch menu
-made from `project-switch-commands'."
- (interactive)
- (let ((dir (project-prompt-project-dir))
- (choice nil))
+made from `project-switch-commands'.
+
+When called in a program, it will use the project corresponding
+to directory DIR."
+ (interactive (list (project-prompt-project-dir)))
+ (let ((choice nil))
(while (not choice)
(setq choice (assq (read-event (project--keymap-prompt))
project-switch-commands)))
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 6db7a14a241..bcf7bfdefc8 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -501,18 +501,18 @@ point to the corresponding spot in the PostScript window, if input
to the interpreter was sent from that window.
Typing \\\\[ps-run-goto-error] when the cursor is at the number has the same effect."
(setq-local syntax-propertize-function #'ps-mode-syntax-propertize)
- (set (make-local-variable 'font-lock-defaults)
- '((ps-mode-font-lock-keywords
- ps-mode-font-lock-keywords-1
- ps-mode-font-lock-keywords-2
- ps-mode-font-lock-keywords-3)
- nil))
+ (setq-local font-lock-defaults
+ '((ps-mode-font-lock-keywords
+ ps-mode-font-lock-keywords-1
+ ps-mode-font-lock-keywords-2
+ ps-mode-font-lock-keywords-3)
+ nil))
(smie-setup nil #'ps-mode-smie-rules)
(setq-local electric-indent-chars
(append '(?> ?\] ?\}) electric-indent-chars))
- (set (make-local-variable 'comment-start) "%")
+ (setq-local comment-start "%")
;; NOTE: `\' has a special meaning in strings only
- (set (make-local-variable 'comment-start-skip) "%+[ \t]*")
+ (setq-local comment-start-skip "%+[ \t]*")
;; enable doc-view-minor-mode => C-c C-c starts viewing the current ps file
;; with doc-view-mode.
(doc-view-minor-mode 1))
@@ -910,11 +910,11 @@ plus the usually uncoded characters inserted on positions 1 through 28."
(define-derived-mode ps-run-mode comint-mode "Interactive PS"
"Major mode in interactive PostScript window.
This mode is invoked from `ps-mode' and should not be called directly."
- (set (make-local-variable 'font-lock-defaults)
- '((ps-run-font-lock-keywords
- ps-run-font-lock-keywords-1
- ps-run-font-lock-keywords-2)
- t))
+ (setq-local font-lock-defaults
+ '((ps-run-font-lock-keywords
+ ps-run-font-lock-keywords-1
+ ps-run-font-lock-keywords-2)
+ t))
(setq mode-line-process '(":%s")))
(defun ps-run-running ()
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index e9c3b3986aa..d75944a702f 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -4,8 +4,8 @@
;; Author: Fabián E. Gallina
;; URL: https://github.com/fgallina/python.el
-;; Version: 0.27
-;; Package-Requires: ((emacs "24.1") (cl-lib "1.0"))
+;; Version: 0.27.1
+;; Package-Requires: ((emacs "24.2") (cl-lib "1.0"))
;; Maintainer: emacs-devel@gnu.org
;; Created: Jul 2010
;; Keywords: languages
@@ -875,7 +875,7 @@ work on `python-indent-calculate-indentation' instead."
(python-util-forward-comment)
(current-indentation))))
(if (and indentation (not (zerop indentation)))
- (set (make-local-variable 'python-indent-offset) indentation)
+ (setq-local python-indent-offset indentation)
(when python-indent-guess-indent-offset-verbose
(message "Can't guess python-indent-offset, using defaults: %s"
python-indent-offset))))))))
@@ -2623,7 +2623,7 @@ also `with-current-buffer'."
(set-buffer python-shell--font-lock-buffer)
(when (not font-lock-mode)
(font-lock-mode 1))
- (set (make-local-variable 'delay-mode-hooks) t)
+ (setq-local delay-mode-hooks t)
(let ((python-indent-guess-indent-offset nil))
(when (not (derived-mode-p 'python-mode))
(python-mode))
@@ -2702,7 +2702,7 @@ With argument MSG show activation message."
(interactive "p")
(python-shell-with-shell-buffer
(python-shell-font-lock-kill-buffer)
- (set (make-local-variable 'python-shell--font-lock-buffer) nil)
+ (setq-local python-shell--font-lock-buffer nil)
(add-hook 'post-command-hook
#'python-shell-font-lock-post-command-hook nil 'local)
(add-hook 'kill-buffer-hook
@@ -2725,7 +2725,7 @@ With argument MSG show deactivation message."
(cdr (python-util-comint-last-prompt))
(line-end-position)
'(face nil font-lock-face nil)))
- (set (make-local-variable 'python-shell--font-lock-buffer) nil)
+ (setq-local python-shell--font-lock-buffer nil)
(remove-hook 'post-command-hook
#'python-shell-font-lock-post-command-hook 'local)
(remove-hook 'kill-buffer-hook
@@ -2741,8 +2741,8 @@ With argument MSG show deactivation message."
With argument MSG show activation/deactivation message."
(interactive "p")
(python-shell-with-shell-buffer
- (set (make-local-variable 'python-shell-font-lock-enable)
- (not python-shell-font-lock-enable))
+ (setq-local python-shell-font-lock-enable
+ (not python-shell-font-lock-enable))
(if python-shell-font-lock-enable
(python-shell-font-lock-turn-on msg)
(python-shell-font-lock-turn-off msg))
@@ -2765,9 +2765,9 @@ eventually provide a shell."
(defun python-shell-comint-watch-for-first-prompt-output-filter (output)
"Run `python-shell-first-prompt-hook' when first prompt is found in OUTPUT."
(when (not python-shell--first-prompt-received)
- (set (make-local-variable 'python-shell--first-prompt-received-output-buffer)
- (concat python-shell--first-prompt-received-output-buffer
- (ansi-color-filter-apply output)))
+ (setq-local python-shell--first-prompt-received-output-buffer
+ (concat python-shell--first-prompt-received-output-buffer
+ (ansi-color-filter-apply output)))
(when (python-shell-comint-end-of-output-p
python-shell--first-prompt-received-output-buffer)
(if (string-match-p
@@ -2775,7 +2775,7 @@ eventually provide a shell."
(or python-shell--first-prompt-received-output-buffer ""))
;; Skip pdb prompts and reset the buffer.
(setq python-shell--first-prompt-received-output-buffer nil)
- (set (make-local-variable 'python-shell--first-prompt-received) t)
+ (setq-local python-shell--first-prompt-received t)
(setq python-shell--first-prompt-received-output-buffer nil)
(with-current-buffer (current-buffer)
(let ((inhibit-quit nil))
@@ -2815,30 +2815,30 @@ variable.
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
(when python-shell--parent-buffer
(python-util-clone-local-variables python-shell--parent-buffer))
- (set (make-local-variable 'indent-tabs-mode) nil)
+ (setq-local indent-tabs-mode nil)
;; Users can interactively override default values for
;; `python-shell-interpreter' and `python-shell-interpreter-args'
;; when calling `run-python'. This ensures values let-bound in
;; `python-shell-make-comint' are locally set if needed.
- (set (make-local-variable 'python-shell-interpreter)
- (or python-shell--interpreter python-shell-interpreter))
- (set (make-local-variable 'python-shell-interpreter-args)
- (or python-shell--interpreter-args python-shell-interpreter-args))
- (set (make-local-variable 'python-shell--prompt-calculated-input-regexp) nil)
- (set (make-local-variable 'python-shell--block-prompt) nil)
- (set (make-local-variable 'python-shell--prompt-calculated-output-regexp) nil)
+ (setq-local python-shell-interpreter
+ (or python-shell--interpreter python-shell-interpreter))
+ (setq-local python-shell-interpreter-args
+ (or python-shell--interpreter-args python-shell-interpreter-args))
+ (setq-local python-shell--prompt-calculated-input-regexp nil)
+ (setq-local python-shell--block-prompt nil)
+ (setq-local python-shell--prompt-calculated-output-regexp nil)
(python-shell-prompt-set-calculated-regexps)
(setq comint-prompt-regexp python-shell--prompt-calculated-input-regexp)
- (set (make-local-variable 'comint-prompt-read-only) t)
+ (setq-local comint-prompt-read-only t)
(setq mode-line-process '(":%s"))
- (set (make-local-variable 'comint-output-filter-functions)
- '(ansi-color-process-output
- python-shell-comint-watch-for-first-prompt-output-filter
- python-comint-postoutput-scroll-to-bottom
- comint-watch-for-password-prompt))
+ (setq-local comint-output-filter-functions
+ '(ansi-color-process-output
+ python-shell-comint-watch-for-first-prompt-output-filter
+ python-comint-postoutput-scroll-to-bottom
+ comint-watch-for-password-prompt))
(setq-local comint-highlight-input nil)
- (set (make-local-variable 'compilation-error-regexp-alist)
- python-shell-compilation-regexp-alist)
+ (setq-local compilation-error-regexp-alist
+ python-shell-compilation-regexp-alist)
(add-hook 'completion-at-point-functions
#'python-shell-completion-at-point nil 'local)
(define-key inferior-python-mode-map "\t"
@@ -3605,7 +3605,7 @@ __PYTHON_EL_native_completion_setup()" process)
With argument MSG show deactivation message."
(interactive "p")
(python-shell-with-shell-buffer
- (set (make-local-variable 'python-shell-completion-native-enable) nil)
+ (setq-local python-shell-completion-native-enable nil)
(when msg
(message "Shell native completion is disabled, using fallback"))))
@@ -3614,7 +3614,7 @@ With argument MSG show deactivation message."
With argument MSG show deactivation message."
(interactive "p")
(python-shell-with-shell-buffer
- (set (make-local-variable 'python-shell-completion-native-enable) t)
+ (setq-local python-shell-completion-native-enable t)
(python-shell-completion-native-turn-on-maybe msg)))
(defun python-shell-completion-native-turn-on-maybe (&optional msg)
@@ -3994,7 +3994,7 @@ Argument OUTPUT is a string with the output from the comint process."
(tracked-buffer-window (get-buffer-window tracked-buffer))
(tracked-buffer-line-pos))
(with-current-buffer tracked-buffer
- (set (make-local-variable 'overlay-arrow-position) (make-marker))
+ (setq-local overlay-arrow-position (make-marker))
(setq tracked-buffer-line-pos (progn
(goto-char (point-min))
(forward-line (1- line-number))
@@ -5535,48 +5535,43 @@ REPORT-FN is Flymake's callback function."
"Major mode for editing Python files.
\\{python-mode-map}"
- (set (make-local-variable 'tab-width) 8)
- (set (make-local-variable 'indent-tabs-mode) nil)
+ (setq-local tab-width 8)
+ (setq-local indent-tabs-mode nil)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-start-skip) "#+\\s-*")
+ (setq-local comment-start "# ")
+ (setq-local comment-start-skip "#+\\s-*")
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (setq-local parse-sexp-lookup-properties t)
+ (setq-local parse-sexp-ignore-comments t)
- (set (make-local-variable 'forward-sexp-function)
- 'python-nav-forward-sexp)
+ (setq-local forward-sexp-function #'python-nav-forward-sexp)
- (set (make-local-variable 'font-lock-defaults)
- `(,python-font-lock-keywords
- nil nil nil nil
- (font-lock-syntactic-face-function
- . python-font-lock-syntactic-face-function)))
+ (setq-local font-lock-defaults
+ `(,python-font-lock-keywords
+ nil nil nil nil
+ (font-lock-syntactic-face-function
+ . python-font-lock-syntactic-face-function)))
- (set (make-local-variable 'syntax-propertize-function)
- python-syntax-propertize-function)
+ (setq-local syntax-propertize-function
+ python-syntax-propertize-function)
- (set (make-local-variable 'indent-line-function)
- #'python-indent-line-function)
- (set (make-local-variable 'indent-region-function) #'python-indent-region)
+ (setq-local indent-line-function #'python-indent-line-function)
+ (setq-local indent-region-function #'python-indent-region)
;; Because indentation is not redundant, we cannot safely reindent code.
- (set (make-local-variable 'electric-indent-inhibit) t)
- (set (make-local-variable 'electric-indent-chars)
- (cons ?: electric-indent-chars))
+ (setq-local electric-indent-inhibit t)
+ (setq-local electric-indent-chars
+ (cons ?: electric-indent-chars))
;; Add """ ... """ pairing to electric-pair-mode.
(add-hook 'post-self-insert-hook
#'python-electric-pair-string-delimiter 'append t)
- (set (make-local-variable 'paragraph-start) "\\s-*$")
- (set (make-local-variable 'fill-paragraph-function)
- #'python-fill-paragraph)
- (set (make-local-variable 'normal-auto-fill-function) #'python-do-auto-fill)
+ (setq-local paragraph-start "\\s-*$")
+ (setq-local fill-paragraph-function #'python-fill-paragraph)
+ (setq-local normal-auto-fill-function #'python-do-auto-fill)
- (set (make-local-variable 'beginning-of-defun-function)
- #'python-nav-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
- #'python-nav-end-of-defun)
+ (setq-local beginning-of-defun-function #'python-nav-beginning-of-defun)
+ (setq-local end-of-defun-function #'python-nav-end-of-defun)
(add-hook 'completion-at-point-functions
#'python-completion-at-point nil 'local)
@@ -5584,26 +5579,25 @@ REPORT-FN is Flymake's callback function."
(add-hook 'post-self-insert-hook
#'python-indent-post-self-insert-function 'append 'local)
- (set (make-local-variable 'imenu-create-index-function)
- #'python-imenu-create-index)
+ (setq-local imenu-create-index-function
+ #'python-imenu-create-index)
- (set (make-local-variable 'add-log-current-defun-function)
- #'python-info-current-defun)
+ (setq-local add-log-current-defun-function
+ #'python-info-current-defun)
(add-hook 'which-func-functions #'python-info-current-defun nil t)
- (set (make-local-variable 'skeleton-further-elements)
- '((abbrev-mode nil)
- (< '(backward-delete-char-untabify (min python-indent-offset
- (current-column))))
- (^ '(- (1+ (current-indentation))))))
+ (setq-local skeleton-further-elements
+ '((abbrev-mode nil)
+ (< '(backward-delete-char-untabify (min python-indent-offset
+ (current-column))))
+ (^ '(- (1+ (current-indentation))))))
(with-no-warnings
;; suppress warnings about eldoc-documentation-function being obsolete
(if (null eldoc-documentation-function)
;; Emacs<25
- (set (make-local-variable 'eldoc-documentation-function)
- #'python-eldoc-function)
+ (setq-local eldoc-documentation-function #'python-eldoc-function)
(if (boundp 'eldoc-documentation-functions)
(add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t)
(add-function :before-until (local 'eldoc-documentation-function)
@@ -5620,16 +5614,14 @@ REPORT-FN is Flymake's callback function."
python-hideshow-forward-sexp-function
nil))
- (set (make-local-variable 'outline-regexp)
- (python-rx (* space) block-start))
- (set (make-local-variable 'outline-heading-end-regexp) ":[^\n]*\n")
- (set (make-local-variable 'outline-level)
- #'(lambda ()
- "`outline-level' function for Python mode."
- (1+ (/ (current-indentation) python-indent-offset))))
+ (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."
+ (1+ (/ (current-indentation) python-indent-offset))))
- (set (make-local-variable 'prettify-symbols-alist)
- python-prettify-symbols-alist)
+ (setq-local prettify-symbols-alist python-prettify-symbols-alist)
(python-skeleton-add-menu-items)
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index be3edfdc6e4..44d4a9ca449 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -365,22 +365,22 @@ Variables controlling indentation style:
Turning on SIMULA mode calls the value of the variable simula-mode-hook
with no arguments, if that value is non-nil."
- (set (make-local-variable 'comment-column) 40)
- ;; (set (make-local-variable 'end-comment-column) 75)
- (set (make-local-variable 'paragraph-start) "[ \t]*$\\|\f")
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'indent-line-function) 'simula-indent-line)
- (set (make-local-variable 'comment-start) "! ")
- (set (make-local-variable 'comment-end) " ;")
- (set (make-local-variable 'comment-start-skip) "!+ *")
- (set (make-local-variable 'parse-sexp-ignore-comments) nil)
- (set (make-local-variable 'comment-multi-line) t)
- (set (make-local-variable 'font-lock-defaults)
- '((simula-font-lock-keywords simula-font-lock-keywords-1
- simula-font-lock-keywords-2 simula-font-lock-keywords-3)
- nil t ((?_ . "w"))))
- (set (make-local-variable 'syntax-propertize-function)
- simula-syntax-propertize-function)
+ (setq-local comment-column 40)
+ ;; (setq-local end-comment-column 75)
+ (setq-local paragraph-start "[ \t]*$\\|\f")
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local indent-line-function 'simula-indent-line)
+ (setq-local comment-start "! ")
+ (setq-local comment-end " ;")
+ (setq-local comment-start-skip "!+ *")
+ (setq-local parse-sexp-ignore-comments nil)
+ (setq-local comment-multi-line t)
+ (setq-local font-lock-defaults
+ '((simula-font-lock-keywords simula-font-lock-keywords-1
+ simula-font-lock-keywords-2 simula-font-lock-keywords-3)
+ nil t ((?_ . "w"))))
+ (setq-local syntax-propertize-function
+ simula-syntax-propertize-function)
(abbrev-mode 1))
(defun simula-indent-exp ()
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 0bf9a517aa6..78f8577ef99 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -6,7 +6,6 @@
;; Maintainer: Michael Mauger
;; Version: 3.6
;; Keywords: comm languages processes
-;; URL: https://savannah.gnu.org/projects/emacs/
;; This file is part of GNU Emacs.
@@ -1725,7 +1724,7 @@ to add functions and PL/SQL keywords.")
"ORDER BY 2 DESC, 3 DESC, 4 DESC, 5 DESC, 6 DESC, 1;")
nil nil)
(with-current-buffer b
- (set (make-local-variable 'sql-product) 'oracle)
+ (setq-local sql-product 'oracle)
(sql-product-font-lock t nil)
(font-lock-mode +1)))))
@@ -2812,7 +2811,7 @@ configured."
((syntax-alist (sql-product-font-lock-syntax-alist)))
;; Get the product-specific keywords.
- (set (make-local-variable 'sql-mode-font-lock-keywords)
+ (setq-local sql-mode-font-lock-keywords
(append
(unless (eq sql-product 'ansi)
(sql-get-product-feature sql-product :font-lock))
@@ -2824,7 +2823,7 @@ configured."
;; Setup font-lock. Force re-parsing of `font-lock-defaults'.
(kill-local-variable 'font-lock-set-defaults)
- (set (make-local-variable 'font-lock-defaults)
+ (setq-local font-lock-defaults
(list 'sql-mode-font-lock-keywords
keywords-only t syntax-alist))
@@ -4134,8 +4133,8 @@ details or extends the listing to include other schemas objects."
(sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)
(with-current-buffer sqlbuf
;; Contains the name of database objects
- (set (make-local-variable 'sql-contains-names) t)
- (set (make-local-variable 'sql-buffer) sqlbuf))))
+ (setq-local sql-contains-names t)
+ (setq-local sql-buffer sqlbuf))))
(defun sql-list-table (name &optional enhanced)
"List the details of a database table named NAME.
@@ -4190,7 +4189,7 @@ must tell Emacs. Here's how to do that in your init file:
(easy-menu-add sql-mode-menu))
;; (smie-setup sql-smie-grammar #'sql-smie-rules)
- (set (make-local-variable 'comment-start) "--")
+ (setq-local comment-start "--")
;; Make each buffer in sql-mode remember the "current" SQLi buffer.
(make-local-variable 'sql-buffer)
;; Add imenu support for sql-mode. Note that imenu-generic-expression
@@ -4200,12 +4199,12 @@ must tell Emacs. Here's how to do that in your init file:
imenu-case-fold-search t)
;; Make `sql-send-paragraph' work on paragraphs that contain indented
;; lines.
- (set (make-local-variable 'paragraph-separate) "[\f]*$")
- (set (make-local-variable 'paragraph-start) "[\n\f]")
+ (setq-local paragraph-separate "[\f]*$")
+ (setq-local paragraph-start "[\n\f]")
;; Abbrevs
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
- (set (make-local-variable 'sql-contains-names) t)
+ (setq-local sql-contains-names t)
(setq-local syntax-propertize-function
(syntax-propertize-rules
;; Handle escaped apostrophes within strings.
@@ -4304,9 +4303,8 @@ you entered, right above the output it created.
:after-hook (sql--adjust-interactive-setup)
;; Get the `sql-product' for this interactive session.
- (set (make-local-variable 'sql-product)
- (or sql-interactive-product
- sql-product))
+ (setq-local sql-product (or sql-interactive-product
+ sql-product))
;; Setup the mode.
(setq mode-name
@@ -4323,7 +4321,7 @@ you entered, right above the output it created.
(sql-product-font-lock t nil)
;; Enable commenting and uncommenting of the region.
- (set (make-local-variable 'comment-start) "--")
+ (setq-local comment-start "--")
;; Abbreviation table init and case-insensitive. It is not activated
;; by default.
(setq local-abbrev-table sql-mode-abbrev-table)
@@ -4332,27 +4330,27 @@ you entered, right above the output it created.
(let ((proc (get-buffer-process (current-buffer))))
(when proc (set-process-sentinel proc #'sql-stop)))
;; Save the connection and login params
- (set (make-local-variable 'sql-user) sql-user)
- (set (make-local-variable 'sql-database) sql-database)
- (set (make-local-variable 'sql-server) sql-server)
- (set (make-local-variable 'sql-port) sql-port)
- (set (make-local-variable 'sql-connection) sql-connection)
+ (setq-local sql-user sql-user)
+ (setq-local sql-database sql-database)
+ (setq-local sql-server sql-server)
+ (setq-local sql-port sql-port)
+ (setq-local sql-connection sql-connection)
(setq-default sql-connection nil)
;; Contains the name of database objects
- (set (make-local-variable 'sql-contains-names) t)
+ (setq-local sql-contains-names t)
;; Keep track of existing object names
- (set (make-local-variable 'sql-completion-object) nil)
- (set (make-local-variable 'sql-completion-column) nil)
+ (setq-local sql-completion-object nil)
+ (setq-local sql-completion-column nil)
;; Create a useful name for renaming this buffer later.
- (set (make-local-variable 'sql-alternate-buffer-name)
- (sql-make-alternate-buffer-name))
+ (setq-local sql-alternate-buffer-name
+ (sql-make-alternate-buffer-name))
;; User stuff. Initialize before the hook.
- (set (make-local-variable 'sql-prompt-regexp)
- (or (sql-get-product-feature sql-product :prompt-regexp) "^"))
- (set (make-local-variable 'sql-prompt-length)
- (sql-get-product-feature sql-product :prompt-length))
- (set (make-local-variable 'sql-prompt-cont-regexp)
- (sql-get-product-feature sql-product :prompt-cont-regexp))
+ (setq-local sql-prompt-regexp
+ (or (sql-get-product-feature sql-product :prompt-regexp) "^"))
+ (setq-local sql-prompt-length
+ (sql-get-product-feature sql-product :prompt-length))
+ (setq-local sql-prompt-cont-regexp
+ (sql-get-product-feature sql-product :prompt-cont-regexp))
(make-local-variable 'sql-output-newline-count)
(make-local-variable 'sql-preoutput-hold)
(add-hook 'comint-preoutput-filter-functions
@@ -4370,7 +4368,7 @@ you entered, right above the output it created.
sql-prompt-regexp))
(setq left-margin (or sql-prompt-length 0))
;; Install input sender
- (set (make-local-variable 'comint-input-sender) #'sql-input-sender)
+ (setq-local comint-input-sender #'sql-input-sender)
;; People wanting a different history file for each
;; buffer/process/client/whatever can change separator and file-name
;; on the sql-interactive-mode-hook.
@@ -4651,8 +4649,7 @@ the call to \\[sql-product-interactive] with
;; Set the new buffer name
(setq new-sqli-buffer (current-buffer))
- (set (make-local-variable 'sql-buffer)
- (buffer-name new-sqli-buffer))
+ (setq-local sql-buffer (buffer-name new-sqli-buffer))
;; Set `sql-buffer' in the start buffer
(with-current-buffer start-buffer
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index 0f2c9431f6e..b0df90995bf 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -332,7 +332,7 @@ as parts of words: e.g., in `superword-mode',
searching subwords in order to avoid unwanted reentrancy.")
(defun subword-setup-buffer ()
- (set (make-local-variable 'find-word-boundary-function-table)
+ (setq-local find-word-boundary-function-table
(if (or subword-mode superword-mode)
subword-find-word-boundary-function-table
subword-empty-char-table)))
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index ff3fb9657d6..dbf6684b0e9 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -616,41 +616,39 @@ Turning on Tcl mode runs `tcl-mode-hook'. Read the documentation for
`tcl-mode-hook' to see what kinds of interesting hook functions
already exist."
(unless (and (boundp 'filladapt-mode) filladapt-mode)
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t))
+ (setq-local paragraph-ignore-fill-prefix t))
- (set (make-local-variable 'indent-line-function) #'tcl-indent-line)
- (set (make-local-variable 'comment-indent-function) #'tcl-comment-indent)
+ (setq-local indent-line-function #'tcl-indent-line)
+ (setq-local comment-indent-function #'tcl-comment-indent)
;; Tcl doesn't require a final newline.
- ;; (make-local-variable 'require-final-newline)
- ;; (setq require-final-newline t)
+ ;; (setq-local require-final-newline t)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[;{[]\\)\\s-*\\)#+ *")
- (set (make-local-variable 'comment-end) "")
+ (setq-local comment-start "# ")
+ (setq-local comment-start-skip
+ "\\(\\(^\\|[;{[]\\)\\s-*\\)#+ *")
+ (setq-local comment-end "")
- (set (make-local-variable 'outline-regexp) ".")
- (set (make-local-variable 'outline-level) 'tcl-outline-level)
+ (setq-local outline-regexp ".")
+ (setq-local outline-level 'tcl-outline-level)
- (set (make-local-variable 'font-lock-defaults)
- '(tcl-font-lock-keywords nil nil nil beginning-of-defun))
- (set (make-local-variable 'syntax-propertize-function)
- tcl-syntax-propertize-function)
+ (setq-local font-lock-defaults
+ '(tcl-font-lock-keywords nil nil nil beginning-of-defun))
+ (setq-local syntax-propertize-function
+ tcl-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
- (set (make-local-variable 'imenu-generic-expression)
- tcl-imenu-generic-expression)
+ (setq-local imenu-generic-expression tcl-imenu-generic-expression)
;; Settings for new dabbrev code.
- (set (make-local-variable 'dabbrev-case-fold-search) nil)
- (set (make-local-variable 'dabbrev-case-replace) nil)
- (set (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) "[$!]")
- (set (make-local-variable 'dabbrev-abbrev-char-regexp) "\\sw\\|\\s_")
+ (setq-local dabbrev-case-fold-search nil)
+ (setq-local dabbrev-case-replace nil)
+ (setq-local dabbrev-abbrev-skip-leading-regexp "[$!]")
+ (setq-local dabbrev-abbrev-char-regexp "\\sw\\|\\s_")
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp)
- (set (make-local-variable 'add-log-current-defun-function)
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local defun-prompt-regexp tcl-omit-ws-regexp)
+ (setq-local add-log-current-defun-function
#'tcl-add-log-defun)
(setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function)
@@ -1201,14 +1199,14 @@ Variables controlling Inferior Tcl mode:
The following commands are available:
\\{inferior-tcl-mode-map}"
- (set (make-local-variable 'comint-prompt-regexp)
- (or tcl-prompt-regexp
- (concat "^" (regexp-quote tcl-application) ">")))
+ (setq-local comint-prompt-regexp
+ (or tcl-prompt-regexp
+ (concat "^" (regexp-quote tcl-application) ">")))
(setq mode-line-process '(": %s"))
(setq local-abbrev-table tcl-mode-abbrev-table)
(set-syntax-table tcl-mode-syntax-table)
- (set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp)
- (set (make-local-variable 'inferior-tcl-delete-prompt-marker) (make-marker))
+ (setq-local defun-prompt-regexp tcl-omit-ws-regexp)
+ (setq-local inferior-tcl-delete-prompt-marker (make-marker))
(set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter))
;;;###autoload
@@ -1229,7 +1227,7 @@ See documentation for function `inferior-tcl-mode' for more information."
(unless (process-tty-name (inferior-tcl-proc))
(tcl-send-string (inferior-tcl-proc)
"set ::tcl_interactive 1; concat\n")))
- (set (make-local-variable 'tcl-application) cmd)
+ (setq-local tcl-application cmd)
(setq inferior-tcl-buffer "*inferior-tcl*")
(pop-to-buffer "*inferior-tcl*"))
@@ -1493,7 +1491,7 @@ Prefix argument means switch to the Tcl buffer afterwards."
(interactive "P")
(auto-fill-mode arg)
(if auto-fill-function
- (set (make-local-variable 'comment-auto-fill-only-comments) t)
+ (setq-local comment-auto-fill-only-comments t)
(kill-local-variable 'comment-auto-fill-only-comments)))
(defun tcl-electric-hash (&optional count)
@@ -1574,7 +1572,7 @@ The first line is assumed to look like \"#!.../program ...\"."
(save-excursion
(goto-char (point-min))
(if (looking-at "#![^ \t]*/\\([^ \t\n/]+\\)\\([ \t]\\|$\\)")
- (set (make-local-variable 'tcl-application) (match-string 1)))))
+ (setq-local tcl-application (match-string 1)))))
(defun tcl-popup-menu (_e)
"XEmacs menu support."
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 266f40abbae..a524bbaa223 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -293,7 +293,7 @@ If no function name is found, return nil."
(null which-function-imenu-failed))
(ignore-errors (imenu--make-index-alist t))
(unless imenu--index-alist
- (set (make-local-variable 'which-function-imenu-failed) t)))
+ (setq-local which-function-imenu-failed t)))
;; If we have an index alist, use it.
(when (and (null name)
(boundp 'imenu--index-alist) imenu--index-alist)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 9f5fc57142b..6e99e9d8ace 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,7 +1,7 @@
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
-;; Version: 1.0.3
+;; Version: 1.0.4
;; Package-Requires: ((emacs "26.3"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -593,6 +593,25 @@ SELECT is `quit', also quit the *xref* window."
(xref--search-property 'xref-item t)
(xref-show-location-at-point))
+(defun xref-next-group ()
+ "Move to the first item of the next xref group and display its source."
+ (interactive)
+ (xref--search-property 'xref-group)
+ (xref--search-property 'xref-item)
+ (xref-show-location-at-point))
+
+(defun xref-prev-group ()
+ "Move to the first item of the previous xref group and display its source."
+ (interactive)
+ ;; Search for the xref group of the current item, provided that the
+ ;; point is not already in an xref group.
+ (unless (plist-member (text-properties-at (point)) 'xref-group)
+ (xref--search-property 'xref-group t))
+ ;; Search for the previous xref group.
+ (xref--search-property 'xref-group t)
+ (xref--search-property 'xref-item)
+ (xref-show-location-at-point))
+
(defun xref--item-at-point ()
(save-excursion
(back-to-indentation)
@@ -738,6 +757,8 @@ references displayed in the current *xref* buffer."
(let ((map (make-sparse-keymap)))
(define-key map (kbd "n") #'xref-next-line)
(define-key map (kbd "p") #'xref-prev-line)
+ (define-key map (kbd "N") #'xref-next-group)
+ (define-key map (kbd "P") #'xref-prev-group)
(define-key map (kbd "r") #'xref-query-replace-in-results)
(define-key map (kbd "RET") #'xref-goto-xref)
(define-key map (kbd "TAB") #'xref-quit-and-goto-xref)
@@ -1334,7 +1355,9 @@ The template should have the following fields:
for the regexp itself (in Extended format)"
:type '(repeat
(cons (symbol :tag "Program identifier")
- (string :tag "Command template"))))
+ (string :tag "Command template")))
+ :version "28.1"
+ :package-version '(xref . "1.0.4"))
(defcustom xref-search-program 'grep
"The program to use for regexp search inside files.
@@ -1343,7 +1366,9 @@ This must reference a corresponding entry in `xref-search-program-alist'."
:type `(choice
(const :tag "Use Grep" grep)
(const :tag "Use ripgrep" ripgrep)
- (symbol :tag "User defined")))
+ (symbol :tag "User defined"))
+ :version "28.1"
+ :package-version '(xref . "1.0.4"))
;;;###autoload
(defun xref-matches-in-files (regexp files)
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index c6997862f7f..cdbafbaf897 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -173,7 +173,7 @@ With argument, asks for a command line."
(setq-default xscheme-process-command-line command-line)
(switch-to-buffer
(xscheme-start-process command-line process-name buffer-name))
- (set (make-local-variable 'xscheme-process-command-line) command-line))
+ (setq-local xscheme-process-command-line command-line))
(defun xscheme-read-command-line (arg)
(let ((default
@@ -264,11 +264,11 @@ With argument, asks for a command line."
xscheme-buffer-name
t)))
(let ((process-name (verify-xscheme-buffer buffer-name t)))
- (set (make-local-variable 'xscheme-buffer-name) buffer-name)
- (set (make-local-variable 'xscheme-process-name) process-name)
- (set (make-local-variable 'xscheme-runlight)
- (with-current-buffer buffer-name
- xscheme-runlight))))
+ (setq-local xscheme-buffer-name buffer-name)
+ (setq-local xscheme-process-name process-name)
+ (setq-local xscheme-runlight
+ (with-current-buffer buffer-name
+ xscheme-runlight))))
(defun local-clear-scheme-interaction-buffer ()
"Make the current buffer use the default scheme interaction buffer."
@@ -375,10 +375,10 @@ Entry to this mode runs `scheme-mode-hook' and then
(kill-all-local-variables)
(make-local-variable 'xscheme-runlight-string)
(make-local-variable 'xscheme-runlight)
- (set (make-local-variable 'xscheme-previous-mode) previous-mode)
+ (setq-local xscheme-previous-mode previous-mode)
(let ((buffer (current-buffer)))
- (set (make-local-variable 'xscheme-buffer-name) (buffer-name buffer))
- (set (make-local-variable 'xscheme-last-input-end) (make-marker))
+ (setq-local xscheme-buffer-name (buffer-name buffer))
+ (setq-local xscheme-last-input-end (make-marker))
(let ((process (get-buffer-process buffer)))
(when process
(setq-local xscheme-process-name (process-name process))
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 61c39de12b2..746363728b0 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1127,7 +1127,7 @@ IGNORE arguments."
(unless recentf-list
(error "The list of recent files is empty"))
(recentf-dialog (format "*%s - Edit list*" recentf-menu-title)
- (set (make-local-variable 'recentf-edit-list) nil)
+ (setq-local recentf-edit-list nil)
(widget-insert
(format-message
"Click on OK to delete selected files from the recent list.
@@ -1196,8 +1196,8 @@ IGNORE other arguments."
(defun recentf-open-files-items (files)
"Return a list of widgets to display FILES in a dialog buffer."
- (set (make-local-variable 'recentf--files-with-key)
- (recentf-trunc-list files 10))
+ (setq-local recentf--files-with-key
+ (recentf-trunc-list files 10))
(mapcar 'recentf-open-files-item
(append
;; When requested group the files with shortcuts together
diff --git a/lisp/replace.el b/lisp/replace.el
index 3a2ab1d24c8..5ebc5493012 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1706,7 +1706,7 @@ See also `multi-occur'."
(buffer-undo-list t)
(occur--final-pos nil))
(erase-buffer)
- (set (make-local-variable 'occur-highlight-regexp) regexp)
+ (setq-local occur-highlight-regexp regexp)
(let ((count
(if (stringp nlines)
;; Treat nlines as a regexp to collect.
diff --git a/lisp/reveal.el b/lisp/reveal.el
index f9e38646349..b4558e1bebb 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -233,7 +233,7 @@ Also see the `reveal-auto-hide' variable."
:keymap reveal-mode-map
(if reveal-mode
(progn
- (set (make-local-variable 'search-invisible) t)
+ (setq-local search-invisible t)
(add-hook 'post-command-hook 'reveal-post-command nil t))
(kill-local-variable 'search-invisible)
(remove-hook 'post-command-hook 'reveal-post-command t)))
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 82e6178da14..d97abca9ee7 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -584,8 +584,8 @@ format first."
(when (and (not ruler-mode)
(local-variable-p 'header-line-format)
(not (local-variable-p 'ruler-mode-header-line-format-old)))
- (set (make-local-variable 'ruler-mode-header-line-format-old)
- header-line-format))
+ (setq-local ruler-mode-header-line-format-old
+ header-line-format))
(setq header-line-format ruler-mode-header-line-format))
;;;###autoload
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el
index f20ea1bcc87..31808be4372 100644
--- a/lisp/scroll-lock.el
+++ b/lisp/scroll-lock.el
@@ -64,7 +64,7 @@ MS-Windows systems if `w32-scroll-lock-modifier' is non-nil."
(progn
(setq scroll-lock-preserve-screen-pos-save
scroll-preserve-screen-position)
- (set (make-local-variable 'scroll-preserve-screen-position) 'always))
+ (setq-local scroll-preserve-screen-position 'always))
(setq scroll-preserve-screen-position
scroll-lock-preserve-screen-pos-save)))
diff --git a/lisp/server.el b/lisp/server.el
index 056f324ef53..84c2e00b26a 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -268,6 +268,12 @@ the \"-f\" switch otherwise."
:type 'string
:version "23.1")
+(defcustom server-client-instructions t
+ "If non-nil, display instructions on how to exit the client on connection.
+If nil, no instructions are displayed."
+ :version "28.1"
+ :type 'boolean)
+
;; We do not use `temporary-file-directory' here, because emacsclient
;; does not read the init file.
(defvar server-socket-dir
@@ -1333,6 +1339,8 @@ The following commands are accepted by the client:
;; inhibit-quit flag, which is good since `commands' (as well as
;; find-file-noselect via the major-mode) can run arbitrary code,
;; including code that needs to wait.
+ (when (and frame server-raise-frame)
+ (select-frame-set-input-focus frame))
(with-local-quit
(condition-case err
(let ((buffers (server-visit-files files proc nowait)))
@@ -1365,8 +1373,10 @@ The following commands are accepted by the client:
nil)
((and frame (null buffers))
(run-hooks 'server-after-make-frame-hook)
- (message "%s" (substitute-command-keys
- "When done with this frame, type \\[delete-frame]")))
+ (when server-client-instructions
+ (message "%s"
+ (substitute-command-keys
+ "When done with this frame, type \\[delete-frame]"))))
((not (null buffers))
(run-hooks 'server-after-make-frame-hook)
(server-switch-buffer
@@ -1377,9 +1387,11 @@ The following commands are accepted by the client:
;; where it may be displayed.
(plist-get (process-plist proc) 'frame))
(run-hooks 'server-switch-hook)
- (unless nowait
- (message "%s" (substitute-command-keys
- "When done with a buffer, type \\[server-edit]")))))
+ (when (and (not nowait)
+ server-client-instructions)
+ (message "%s"
+ (substitute-command-keys
+ "When done with a buffer, type \\[server-edit]")))))
(when (and frame (null tty-name))
(server-unselect-display frame)))
((quit error)
@@ -1681,9 +1693,7 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
(switch-to-buffer next-buffer))
;; After all the above, we might still have ended up with
;; a minibuffer/dedicated-window (if there's no other).
- (error (pop-to-buffer next-buffer)))))))
- (when server-raise-frame
- (select-frame-set-input-focus (window-frame)))))
+ (error (pop-to-buffer next-buffer)))))))))
;;;###autoload
(defun server-save-buffers-kill-terminal (arg)
diff --git a/lisp/shell.el b/lisp/shell.el
index 5fed6513b96..5cc9a189c72 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -471,32 +471,32 @@ Shell buffers. It implements `shell-completion-execonly' for
(defun shell-completion-vars ()
"Setup completion vars for `shell-mode' and `read-shell-command'."
- (set (make-local-variable 'comint-completion-fignore)
- shell-completion-fignore)
- (set (make-local-variable 'comint-delimiter-argument-list)
- shell-delimiter-argument-list)
- (set (make-local-variable 'comint-file-name-chars) shell-file-name-chars)
- (set (make-local-variable 'comint-file-name-quote-list)
- shell-file-name-quote-list)
- (set (make-local-variable 'comint-file-name-prefix)
- (or (file-remote-p default-directory) ""))
- (set (make-local-variable 'comint-dynamic-complete-functions)
- shell-dynamic-complete-functions)
+ (setq-local comint-completion-fignore
+ shell-completion-fignore)
+ (setq-local comint-delimiter-argument-list
+ shell-delimiter-argument-list)
+ (setq-local comint-file-name-chars shell-file-name-chars)
+ (setq-local comint-file-name-quote-list
+ shell-file-name-quote-list)
+ (setq-local comint-file-name-prefix
+ (or (file-remote-p default-directory) ""))
+ (setq-local comint-dynamic-complete-functions
+ shell-dynamic-complete-functions)
(setq-local comint-unquote-function #'shell--unquote-argument)
(setq-local comint-requote-function #'shell--requote-argument)
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- #'shell--parse-pcomplete-arguments)
- (set (make-local-variable 'pcomplete-termination-string)
- (cond ((not comint-completion-addsuffix) "")
- ((stringp comint-completion-addsuffix)
- comint-completion-addsuffix)
- ((not (consp comint-completion-addsuffix)) " ")
- (t (cdr comint-completion-addsuffix))))
- (set (make-local-variable 'pcomplete-command-completion-function)
- #'shell-command-completion-function)
+ (setq-local pcomplete-parse-arguments-function
+ #'shell--parse-pcomplete-arguments)
+ (setq-local pcomplete-termination-string
+ (cond ((not comint-completion-addsuffix) "")
+ ((stringp comint-completion-addsuffix)
+ comint-completion-addsuffix)
+ ((not (consp comint-completion-addsuffix)) " ")
+ (t (cdr comint-completion-addsuffix))))
+ (setq-local pcomplete-command-completion-function
+ #'shell-command-completion-function)
;; Don't use pcomplete's defaulting mechanism, rely on
;; shell-dynamic-complete-functions instead.
- (set (make-local-variable 'pcomplete-default-completion-function) #'ignore)
+ (setq-local pcomplete-default-completion-function #'ignore)
(setq-local comint-input-autoexpand shell-input-autoexpand)
;; Not needed in shell-mode because it's inherited from comint-mode, but
;; placed here for read-shell-command.
@@ -596,7 +596,7 @@ buffer."
(and (stringp hsize)
(integerp (setq hsize (string-to-number hsize)))
(> hsize 0)
- (set (make-local-variable 'comint-input-ring-size) hsize))
+ (setq-local comint-input-ring-size hsize))
(setq comint-input-ring-file-name
(concat
remote
diff --git a/lisp/simple.el b/lisp/simple.el
index 1f90db3dea3..9787ad1a072 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1922,7 +1922,7 @@ to get different commands to edit and resubmit."
(setq execute-extended-command--last-typed
(minibuffer-contents)))
nil 'local)
- (set (make-local-variable 'minibuffer-default-add-function)
+ (setq-local minibuffer-default-add-function
(lambda ()
;; Get a command name at point in the original buffer
;; to propose it after M-n.
@@ -2372,10 +2372,10 @@ negative number -N means the Nth entry of \"future history.\""
(unless (memq last-command '(next-history-element
previous-history-element))
(let ((prompt-end (minibuffer-prompt-end)))
- (set (make-local-variable 'minibuffer-temporary-goal-position)
- (cond ((<= (point) prompt-end) prompt-end)
- ((eobp) nil)
- (t (point))))))
+ (setq-local minibuffer-temporary-goal-position
+ (cond ((<= (point) prompt-end) prompt-end)
+ ((eobp) nil)
+ (t (point))))))
(goto-char (point-max))
(delete-minibuffer-contents)
(setq minibuffer-history-position nabs)
@@ -2548,14 +2548,14 @@ Return 0 if current buffer is not a minibuffer."
(defun minibuffer-history-isearch-setup ()
"Set up a minibuffer for using isearch to search the minibuffer history.
Intended to be added to `minibuffer-setup-hook'."
- (set (make-local-variable 'isearch-search-fun-function)
- 'minibuffer-history-isearch-search)
- (set (make-local-variable 'isearch-message-function)
- 'minibuffer-history-isearch-message)
- (set (make-local-variable 'isearch-wrap-function)
- 'minibuffer-history-isearch-wrap)
- (set (make-local-variable 'isearch-push-state-function)
- 'minibuffer-history-isearch-push-state)
+ (setq-local isearch-search-fun-function
+ #'minibuffer-history-isearch-search)
+ (setq-local isearch-message-function
+ #'minibuffer-history-isearch-message)
+ (setq-local isearch-wrap-function
+ #'minibuffer-history-isearch-wrap)
+ (setq-local isearch-push-state-function
+ #'minibuffer-history-isearch-push-state)
(add-hook 'isearch-mode-end-hook 'minibuffer-history-isearch-end nil t))
(defun minibuffer-history-isearch-end ()
@@ -3585,8 +3585,8 @@ to `shell-command-history'."
(minibuffer-with-setup-hook
(lambda ()
(shell-completion-vars)
- (set (make-local-variable 'minibuffer-default-add-function)
- 'minibuffer-default-add-shell-commands))
+ (setq-local minibuffer-default-add-function
+ #'minibuffer-default-add-shell-commands))
(apply #'read-from-minibuffer prompt initial-contents
minibuffer-local-shell-command-map
nil
@@ -6426,7 +6426,8 @@ for it.")
(<= position (point-max)))
(if widen-automatically
(widen)
- (error "Global mark position is outside accessible part of buffer")))
+ (error "Global mark position is outside accessible part of buffer %s"
+ (buffer-name buffer))))
(goto-char position)
(switch-to-buffer buffer)))
@@ -7201,6 +7202,12 @@ rests."
"Move point to visible beginning of current logical line.
This disregards any invisible newline characters.
+When moving from position that has no `field' property, this
+command doesn't enter text which has non-nil `field' property.
+In particular, when invoked in the minibuffer, the command will
+stop short of entering the text of the minibuffer prompt.
+See `inhibit-field-text-motion' for how to inhibit this.
+
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
\(But if the buffer doesn't end in a newline, it stops at the
@@ -7430,8 +7437,8 @@ Mode' for details."
(if (local-variable-p var)
(push (cons var (symbol-value var))
visual-line--saved-state))))
- (set (make-local-variable 'line-move-visual) t)
- (set (make-local-variable 'truncate-partial-width-windows) nil)
+ (setq-local line-move-visual t)
+ (setq-local truncate-partial-width-windows nil)
(setq truncate-lines nil
word-wrap t
fringe-indicator-alist
@@ -8824,10 +8831,9 @@ Called from `temp-buffer-show-hook'."
(let ((base-position completion-base-position)
(insert-fun completion-list-insert-choice-function))
(completion-list-mode)
- (set (make-local-variable 'completion-base-position) base-position)
- (set (make-local-variable 'completion-list-insert-choice-function)
- insert-fun))
- (set (make-local-variable 'completion-reference-buffer) mainbuf)
+ (setq-local completion-base-position base-position)
+ (setq-local completion-list-insert-choice-function insert-fun))
+ (setq-local completion-reference-buffer mainbuf)
(if base-dir (setq default-directory base-dir))
(when completion-tab-width
(setq tab-width completion-tab-width))
@@ -9287,8 +9293,7 @@ to a non-nil value."
(cond
((and (not buffer-read-only) view-mode)
(View-exit-and-edit)
- (make-local-variable 'view-read-only)
- (setq view-read-only t)) ; Must leave view mode.
+ (setq-local view-read-only t)) ; Must leave view mode.
((and buffer-read-only view-read-only
;; If view-mode is already active, `view-mode-enter' is a nop.
(not view-mode)
@@ -9306,8 +9311,8 @@ and setting it to nil."
(setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec)
(kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
(when visible-mode
- (set (make-local-variable 'vis-mode-saved-buffer-invisibility-spec)
- buffer-invisibility-spec)
+ (setq-local vis-mode-saved-buffer-invisibility-spec
+ buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
(defvar messages-buffer-mode-map
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 6e2c10d9711..5578a937d76 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -312,10 +312,15 @@ automatically, and you are prompted to fill in the variable parts.")))
(save-excursion (insert "\n")))
(unwind-protect
(setq prompt (cond ((stringp prompt)
- (read-string (format prompt skeleton-subprompt)
- (setq initial-input
- (or initial-input
- (symbol-value 'input)))))
+ ;; The user may issue commands to move
+ ;; around (like `C-M-v'). Ensure that we
+ ;; insert the skeleton at the correct
+ ;; (initial) point.
+ (save-excursion
+ (read-string (format prompt skeleton-subprompt)
+ (setq initial-input
+ (or initial-input
+ (symbol-value 'input))))))
((functionp prompt)
(funcall prompt))
(t (eval prompt))))
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 34687805b57..e2cfe9861a5 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -979,10 +979,9 @@ supported at a time.
(speedbar-set-timer dframe-update-speed)
)
;; Frame modifications
- (set (make-local-variable 'dframe-delete-frame-function)
- 'speedbar-handle-delete-frame)
+ (setq-local dframe-delete-frame-function 'speedbar-handle-delete-frame)
;; hscroll
- (set (make-local-variable 'auto-hscroll-mode) nil)
+ (setq-local auto-hscroll-mode nil)
;; reset the selection variable
(setq speedbar-last-selected-file nil))
@@ -1075,9 +1074,8 @@ in the selected file.
(save-excursion
(setq font-lock-keywords nil) ;; no font-locking please
(setq truncate-lines t)
- (make-local-variable 'frame-title-format)
- (setq frame-title-format "Speedbar"
- case-fold-search nil
+ (setq-local frame-title-format "Speedbar")
+ (setq case-fold-search nil
buffer-read-only t)
(speedbar-set-mode-line-format)
;; Add in our dframe hooks.
@@ -1814,16 +1812,13 @@ of the special mode functions."
(setq v (intern-soft (concat ms "-speedbar-key-map")))
(if (not v)
nil ;; don't add special keymap
- (make-local-variable 'speedbar-special-mode-key-map)
- (setq speedbar-special-mode-key-map
- (symbol-value v)))
+ (setq-local speedbar-special-mode-key-map
+ (symbol-value v)))
(setq v (intern-soft (concat ms "-speedbar-menu-items")))
(if (not v)
nil ;; don't add special menus
- (make-local-variable 'speedbar-easymenu-definition-special)
- (setq speedbar-easymenu-definition-special
- (symbol-value v)))
- )))))))
+ (setq-local speedbar-easymenu-definition-special
+ (symbol-value v))))))))))
(defun speedbar-remove-localized-speedbar-support (buffer)
"Remove any traces that BUFFER supports speedbar in a specialized way."
diff --git a/lisp/startup.el b/lisp/startup.el
index e3c792edff0..84a8604535c 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -633,7 +633,7 @@ It is the default value of the variable `top-level'."
(with-current-buffer "*Messages*"
(messages-buffer-mode)
;; Make it easy to do like "tail -f".
- (set (make-local-variable 'window-point-insertion-type) t)
+ (setq-local window-point-insertion-type t)
;; Give *Messages* the same default-directory as *scratch*,
;; just to keep things predictable.
(setq default-directory (or dir (expand-file-name "~/")))))
@@ -2001,7 +2001,7 @@ splash screen in another window."
(setq buffer-read-only nil)
(erase-buffer)
(setq default-directory command-line-default-directory)
- (set (make-local-variable 'tab-width) 8)
+ (setq-local tab-width 8)
(if pure-space-overflow
(insert pure-space-overflow-message))
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 11bc07a29cc..044872068f4 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1231,8 +1231,8 @@ the stroke as a character in some language."
;; mode-popup-menu edit-strokes-menu) ; what about extent-specific stuff?
;; (and (featurep 'menubar)
;; current-menubar
-;; (set (make-local-variable 'current-menubar)
-;; (copy-sequence current-menubar))
+;; (setq-local current-menubar
+;; (copy-sequence current-menubar))
;; (add-submenu nil edit-strokes-menu)))
;;(let ((map edit-strokes-mode-map))
@@ -1363,13 +1363,13 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead."
finally do (unless (eobp)
(kill-region (1+ (point)) (point-max))))
(view-buffer "*Strokes List*" nil)
- (set (make-local-variable 'view-mode-map)
- (let ((map (copy-keymap view-mode-map)))
- (define-key map "q" `(lambda ()
- (interactive)
- (View-quit)
- (set-window-configuration ,config)))
- map))
+ (setq-local view-mode-map
+ (let ((map (copy-keymap view-mode-map)))
+ (define-key map "q" `(lambda ()
+ (interactive)
+ (View-quit)
+ (set-window-configuration ,config)))
+ map))
(goto-char (point-min))))
(defun strokes-alphabetic-lessp (stroke1 stroke2)
diff --git a/lisp/subr.el b/lisp/subr.el
index 4b75268c04d..ed235ee1f72 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2745,20 +2745,22 @@ floating point support."
"Insert the character you type in the minibuffer and exit.
Discard all previous input before inserting and exiting the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (insert last-command-event)
- (exit-minibuffer))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (insert last-command-event)
+ (exit-minibuffer)))
(defun read-char-from-minibuffer-insert-other ()
"Handle inserting of a character other than allowed.
Display an error on trying to insert a disallowed character.
Also discard all previous input in the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (ding)
- (discard-input)
- (minibuffer-message "Wrong answer")
- (sit-for 2))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (ding)
+ (discard-input)
+ (minibuffer-message "Wrong answer")
+ (sit-for 2)))
(defvar empty-history)
@@ -2802,6 +2804,8 @@ There is no need to explicitly add `help-char' to CHARS;
map read-char-from-minibuffer-map-hash)
map))
read-char-from-minibuffer-map))
+ ;; Protect this-command when called from pre-command-hook (bug#45029)
+ (this-command this-command)
(result
(read-from-minibuffer prompt nil map nil
(or history 'empty-history)))
@@ -2856,28 +2860,31 @@ There is no need to explicitly add `help-char' to CHARS;
"Insert the answer \"y\" and exit the minibuffer of `y-or-n-p'.
Discard all previous input before inserting and exiting the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (insert "y")
- (exit-minibuffer))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (insert "y")
+ (exit-minibuffer)))
(defun y-or-n-p-insert-n ()
"Insert the answer \"n\" and exit the minibuffer of `y-or-n-p'.
Discard all previous input before inserting and exiting the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (insert "n")
- (exit-minibuffer))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (insert "n")
+ (exit-minibuffer)))
(defun y-or-n-p-insert-other ()
"Handle inserting of other answers in the minibuffer of `y-or-n-p'.
Display an error on trying to insert a disallowed character.
Also discard all previous input in the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (ding)
- (discard-input)
- (minibuffer-message "Please answer y or n")
- (sit-for 2))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (ding)
+ (discard-input)
+ (minibuffer-message "Please answer y or n")
+ (sit-for 2)))
(defvar empty-history)
@@ -2955,6 +2962,8 @@ is nil and `use-dialog-box' is non-nil."
(let ((help-form msg)) ; lexically bound msg
(help-form-show)))))
map))
+ ;; Protect this-command when called from pre-command-hook (bug#45029)
+ (this-command this-command)
(str (read-from-minibuffer
prompt nil keymap nil
(or y-or-n-p-history-variable 'empty-history))))
@@ -3955,7 +3964,7 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
;; Don't throw `throw-on-input' on those events by default.
(setq while-no-input-ignore-events
'(focus-in focus-out help-echo iconify-frame
- make-frame-visible selection-request buffer-switch))
+ make-frame-visible selection-request))
(defmacro while-no-input (&rest body)
"Execute BODY only as long as there's no pending input.
@@ -5258,6 +5267,8 @@ use `called-interactively-p'.
To test whether a function can be called interactively, use
`commandp'."
+ ;; Kept around for now. See discussion at:
+ ;; https://lists.gnu.org/r/emacs-devel/2020-08/msg00564.html
(declare (obsolete called-interactively-p "23.2"))
(called-interactively-p 'interactive))
@@ -5898,4 +5909,22 @@ returned list are in the same order as in TREE.
(defconst regexp-unmatchable "\\`a\\`"
"Standard regexp guaranteed not to match any string at all.")
+(defun run-hook-query-error-with-timeout (hook)
+ "Run HOOK, catching errors, and querying the user about whether to continue.
+If a function in HOOK signals an error, the user will be prompted
+whether to continue or not. If the user doesn't respond,
+evaluation will continue if the user doesn't respond within five
+seconds."
+ (run-hook-wrapped
+ hook
+ (lambda (fun)
+ (condition-case err
+ (funcall fun)
+ (error
+ (unless (y-or-n-p-with-timeout (format "Error %s; continue?" err)
+ 5 t)
+ (error err))))
+ ;; Continue running.
+ nil)))
+
;;; subr.el ends here
diff --git a/lisp/svg.el b/lisp/svg.el
index eeb945f53b5..1ca59658aa7 100644
--- a/lisp/svg.el
+++ b/lisp/svg.el
@@ -184,6 +184,19 @@ otherwise. IMAGE-TYPE should be a MIME image type, like
`((xlink:href . ,(svg--image-data image image-type datap))
,@(svg--arguments svg args)))))
+(defun svg-embed-base-uri-image (svg relative-filename &rest args)
+ "Insert image placed at RELATIVE-FILENAME into the SVG structure.
+RELATIVE-FILENAME will be searched in `file-name-directory' of the
+image's `:base-uri' property. If `:base-uri' is not specified for the
+image, then embedding won't work. Embedding large images using this
+function is much faster than `svg-embed'."
+ (svg--append
+ svg
+ (dom-node
+ 'image
+ `((xlink:href . ,relative-filename)
+ ,@(svg--arguments svg args)))))
+
(defun svg-text (svg text &rest args)
"Add TEXT to SVG."
(svg--append
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 26049552242..1327bde9088 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -762,6 +762,8 @@ After the tab is created, the hooks in
(from-tab (tab-bar--tab)))
(when tab-bar-new-tab-choice
+ (when (minibuffer-selected-window)
+ (select-window (minibuffer-selected-window)))
(delete-other-windows)
;; Create a new window to get rid of old window parameters
;; (e.g. prev/next buffers) of old window.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index d460c8a4f73..608d997863b 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -588,7 +588,7 @@ For instance, if mode is #o700, then it produces `rwx------'."
(setq pos (tar-header-data-end descriptor))
(progress-reporter-update progress-reporter pos)))
- (set (make-local-variable 'tar-parse-info) (nreverse result))
+ (setq-local tar-parse-info (nreverse result))
;; A tar file should end with a block or two of nulls,
;; but let's not get a fatal error if it doesn't.
(if (null descriptor)
@@ -718,21 +718,21 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
(file-writable-p buffer-file-name)
(setq buffer-read-only nil)) ; undo what `special-mode' did
(make-local-variable 'tar-parse-info)
- (set (make-local-variable 'require-final-newline) nil) ; binary data, dude...
- (set (make-local-variable 'local-enable-local-variables) nil)
- (set (make-local-variable 'next-line-add-newlines) nil)
- (set (make-local-variable 'tar-file-name-coding-system)
- (or file-name-coding-system
- default-file-name-coding-system
- locale-coding-system))
+ (setq-local require-final-newline nil) ; binary data, dude...
+ (setq-local local-enable-local-variables nil)
+ (setq-local next-line-add-newlines nil)
+ (setq-local tar-file-name-coding-system
+ (or file-name-coding-system
+ default-file-name-coding-system
+ locale-coding-system))
;; Prevent loss of data when saving the file.
- (set (make-local-variable 'file-precious-flag) t)
+ (setq-local file-precious-flag t)
(buffer-disable-undo)
(widen)
;; Now move the Tar data into an auxiliary buffer, so we can use the main
;; buffer for the summary.
(cl-assert (not (tar-data-swapped-p)))
- (set (make-local-variable 'revert-buffer-function) #'tar-mode-revert)
+ (setq-local revert-buffer-function #'tar-mode-revert)
;; We started using write-contents-functions, but this hook is not
;; used during auto-save, so we now use
;; write-region-annotate-functions which hooks at a lower-level.
@@ -741,10 +741,10 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
(add-hook 'change-major-mode-hook #'tar-change-major-mode-hook nil t)
;; Tar data is made of bytes, not chars.
(set-buffer-multibyte nil) ;Hopefully a no-op.
- (set (make-local-variable 'tar-data-buffer)
- (generate-new-buffer (format " *tar-data %s*"
- (file-name-nondirectory
- (or buffer-file-name (buffer-name))))))
+ (setq-local tar-data-buffer (generate-new-buffer
+ (format " *tar-data %s*"
+ (file-name-nondirectory
+ (or buffer-file-name (buffer-name))))))
(condition-case err
(progn
(tar-swap-data)
@@ -1004,8 +1004,8 @@ return nil. Otherwise point is returned."
default-directory))
(set-buffer-modified-p nil)
(normal-mode) ; pick a mode.
- (set (make-local-variable 'tar-superior-buffer) tar-buffer)
- (set (make-local-variable 'tar-superior-descriptor) descriptor)
+ (setq-local tar-superior-buffer tar-buffer)
+ (setq-local tar-superior-descriptor descriptor)
(setq buffer-read-only read-only-p)
(tar-subfile-mode 1)))
(cond
diff --git a/lisp/term.el b/lisp/term.el
index 34dc2870f21..2e69af0735b 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -264,7 +264,7 @@
;; M-p term-previous-input Cycle backwards in input history
;; M-n term-next-input Cycle forwards
;; M-r term-previous-matching-input Previous input matching a regexp
-;; M-s comint-next-matching-input Next input that matches
+;; M-s term-next-matching-input Next input that matches
;; return term-send-input
;; C-c C-a term-bol Beginning of line; skip prompt.
;; C-d term-delchar-or-maybe-eof Delete char unless at end of buff.
@@ -1005,12 +1005,12 @@ Entry to this mode runs the hooks on `term-mode-hook'."
;; we do not want indent to sneak in any tabs
(setq indent-tabs-mode nil)
(setq buffer-display-table term-display-table)
- (set (make-local-variable 'term-home-marker) (copy-marker 0))
- (set (make-local-variable 'term-height) (floor (window-screen-lines)))
- (set (make-local-variable 'term-width) (window-max-chars-per-line))
- (set (make-local-variable 'term-last-input-start) (make-marker))
- (set (make-local-variable 'term-last-input-end) (make-marker))
- (set (make-local-variable 'term-last-input-match) "")
+ (setq-local term-home-marker (copy-marker 0))
+ (setq-local term-height (floor (window-screen-lines)))
+ (setq-local term-width (window-max-chars-per-line))
+ (setq-local term-last-input-start (make-marker))
+ (setq-local term-last-input-end (make-marker))
+ (setq-local term-last-input-match "")
;; These local variables are set to their local values:
(make-local-variable 'term-saved-home-marker)
@@ -1028,9 +1028,9 @@ Entry to this mode runs the hooks on `term-mode-hook'."
;; a properly configured ange-ftp, I've decided to be conservative
;; and put them in. -mm
- (set (make-local-variable 'term-ansi-at-host) (system-name))
- (set (make-local-variable 'term-ansi-at-dir) default-directory)
- (set (make-local-variable 'term-ansi-at-message) nil)
+ (setq-local term-ansi-at-host (system-name))
+ (setq-local term-ansi-at-dir default-directory)
+ (setq-local term-ansi-at-message nil)
;; For user tracking purposes -mm
(make-local-variable 'ange-ftp-default-user)
@@ -1073,15 +1073,15 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(make-local-variable 'term-scroll-to-bottom-on-output)
(make-local-variable 'term-scroll-show-maximum-output)
(make-local-variable 'term-ptyp)
- (set (make-local-variable 'term-vertical-motion) 'vertical-motion)
- (set (make-local-variable 'term-pending-delete-marker) (make-marker))
+ (setq-local term-vertical-motion 'vertical-motion)
+ (setq-local term-pending-delete-marker (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
- (set (make-local-variable 'term-pending-frame) nil)
+ (setq-local term-pending-frame nil)
;; Cua-mode's keybindings interfere with the term keybindings, disable it.
- (set (make-local-variable 'cua-mode) nil)
+ (setq-local cua-mode nil)
- (set (make-local-variable 'font-lock-defaults) '(nil t))
+ (setq-local font-lock-defaults '(nil t))
(add-function :filter-return
(local 'filter-buffer-substring-function)
@@ -1423,8 +1423,7 @@ buffer. The hook `term-exec-hook' is run after each exec."
(when proc (delete-process proc)))
;; Crank up a new process
(let ((proc (term-exec-1 name buffer command switches)))
- (make-local-variable 'term-ptyp)
- (setq term-ptyp process-connection-type) ; t if pty, nil if pipe.
+ (setq-local term-ptyp process-connection-type) ; t if pty, nil if pipe.
;; Jump to the end, and set the process mark.
(goto-char (point-max))
(set-marker (process-mark proc) (point))
@@ -3067,8 +3066,7 @@ See `term-prompt-regexp'."
(aset term-terminal-undecoded-bytes 0 ?\r))
(goto-char (point-max)))
;; FIXME: Use (add-function :override (process-filter proc)
- (make-local-variable 'term-pager-old-filter)
- (setq term-pager-old-filter (process-filter proc))
+ (setq-local term-pager-old-filter (process-filter proc))
;; FIXME: Where is `term-pager-filter' set to a function?!
(set-process-filter proc term-pager-filter)
(setq i str-length))
@@ -3537,8 +3535,7 @@ The top-most line is line 0."
;; (stop-process process))
(setq term-pager-old-local-map (current-local-map))
(use-local-map term-pager-break-map)
- (make-local-variable 'term-old-mode-line-format)
- (setq term-old-mode-line-format mode-line-format)
+ (setq-local term-old-mode-line-format mode-line-format)
(setq mode-line-format
(list "-- **MORE** "
mode-line-buffer-identification
diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el
index 952b81621e9..41650eb4371 100644
--- a/lisp/textmodes/bibtex-style.el
+++ b/lisp/textmodes/bibtex-style.el
@@ -66,12 +66,12 @@
;;;###autoload
(define-derived-mode bibtex-style-mode nil "BibStyle"
"Major mode for editing BibTeX style files."
- (set (make-local-variable 'comment-start) "%")
- (set (make-local-variable 'outline-regexp) "^[a-z]")
- (set (make-local-variable 'imenu-generic-expression)
- '((nil "\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}" 2)))
- (set (make-local-variable 'indent-line-function) 'bibtex-style-indent-line)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (setq-local comment-start "%")
+ (setq-local outline-regexp "^[a-z]")
+ (setq-local imenu-generic-expression
+ '((nil "\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}" 2)))
+ (setq-local indent-line-function 'bibtex-style-indent-line)
+ (setq-local parse-sexp-ignore-comments t)
(setq font-lock-defaults
'(bibtex-style-font-lock-keywords nil t
((?. . "w")))))
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 0a0a58244d0..a78219e3f69 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -40,6 +40,8 @@
;;; Code:
+(require 'iso8601)
+
;; User Options:
@@ -2761,12 +2763,16 @@ and `bibtex-autokey-names-stretch'."
(defun bibtex-autokey-get-year ()
"Return year field contents as a string obeying `bibtex-autokey-year-length'."
- (let ((yearfield (bibtex-autokey-get-field '("year" "date"))))
- ;; biblatex date field has format yyyy-mm-dd
- (if (< 4 (length yearfield))
- (setq yearfield (substring yearfield 0 4)))
- (substring yearfield (max 0 (- (length yearfield)
- bibtex-autokey-year-length)))))
+ (let* ((str (bibtex-autokey-get-field '("date" "year"))) ; possibly ""
+ (year (or (and (iso8601-valid-p str)
+ (let ((year (decoded-time-year (iso8601-parse str))))
+ (and year (number-to-string year))))
+ ;; BibTeX permits a year field "(about 1984)", where only
+ ;; the last four nonpunctuation characters must be numerals.
+ (and (string-match "\\([0-9][0-9][0-9][0-9]\\)[^[:alnum:]]*\\'" str)
+ (match-string 1 str))
+ (user-error "Year or date field `%s' invalid" str))))
+ (substring year (max 0 (- (length year) bibtex-autokey-year-length)))))
(defun bibtex-autokey-get-title ()
"Get title field contents up to a terminator.
@@ -2849,12 +2855,12 @@ The name part:
The year part:
1. Build the year part of the key by truncating the content of the year
- field to the rightmost `bibtex-autokey-year-length' digits (useful
- values are 2 and 4).
- 2. If the year field (or any other field required to generate the key)
- is absent, but the entry has a valid crossref field and
- `bibtex-autokey-use-crossref' is non-nil, use the field of the
- crossreferenced entry instead.
+ component of the date or year field to the rightmost
+ `bibtex-autokey-year-length' digits (useful values are 2 and 4).
+ 2. If both the year and date fields are absent, but the entry has a
+ valid crossref field and `bibtex-autokey-use-crossref' is
+ non-nil, use the date or year field of the crossreferenced entry
+ instead.
The title part
1. Change the content of the title field according to
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 984cc08de85..e42615e5158 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -4073,10 +4073,12 @@ cache buffer into the designated cell in the table buffer."
(set-buffer table-cell-buffer)
(let ((cache-buffer (get-buffer-create table-cache-buffer-name))
(org-coord (table--get-coordinate))
+ (fixed table-fixed-width-mode)
(in-cell (equal (table--cell-to-coord (table--probe-cell))
(cons table-cell-info-lu-coordinate table-cell-info-rb-coordinate)))
rectangle)
(set-buffer cache-buffer)
+ (setq-local table-fixed-width-mode fixed)
(setq rectangle
(extract-rectangle
1
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 37ab11ad89f..59238452a4d 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -2331,9 +2331,14 @@ FILE is typically the output DVI or PDF file."
:version "23.1"
:group 'tex-run)
+(defun tex--quote-spec (fspec)
+ (cl-loop for (char . file) in fspec
+ collect (cons char (shell-quote-argument file))))
+
(defun tex-format-cmd (format fspec)
"Like `format-spec' but adds user-specified args to the command.
Only applies the FSPEC to the args part of FORMAT."
+ (setq fspec (tex--quote-spec fspec))
(if (not (string-match "\\([^ /\\]+\\) " format))
(format-spec format fspec)
(let* ((prefix (substring format 0 (match-beginning 0)))
@@ -2430,8 +2435,8 @@ Only applies the FSPEC to the args part of FORMAT."
(prog1 (file-name-directory (expand-file-name file))
(setq file (file-name-nondirectory file))))
(root (file-name-sans-extension file))
- (fspec (list (cons ?r (shell-quote-argument root))
- (cons ?f (shell-quote-argument file))))
+ (fspec (list (cons ?r root)
+ (cons ?f file)))
(default (tex-compile-default fspec)))
(list default-directory
(completing-read
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 3aa7ff0836b..93b7c08d62f 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -347,8 +347,7 @@ If MARKED is non-nil, the image is marked."
:conversion ,(if marked 'disabled)
:margin ,thumbs-margin)))
(insert-image i)
- (set (make-local-variable 'thumbs-current-image-size)
- (image-size i t))))
+ (setq-local thumbs-current-image-size (image-size i t))))
(defun thumbs-insert-thumb (img &optional marked)
"Insert the thumbnail for IMG at point.
@@ -387,7 +386,7 @@ If MARKED is non-nil, the image is marked."
(if dir (setq default-directory dir))
(thumbs-do-thumbs-insertion list)
(goto-char (point-min))
- (set (make-local-variable 'thumbs-current-dir) default-directory)))
+ (setq-local thumbs-current-dir default-directory)))
;;;###autoload
(defun thumbs-show-from-dir (dir &optional reg same-window)
diff --git a/lisp/timezone.el b/lisp/timezone.el
index 8ba70f17fde..1b5e4226e2e 100644
--- a/lisp/timezone.el
+++ b/lisp/timezone.el
@@ -1,4 +1,4 @@
-;;; timezone.el --- time zone package for GNU Emacs -- lexical-binding: t -*-
+;;; timezone.el --- time zone package for GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1990-1993, 1996, 1999, 2001-2020 Free Software
;; Foundation, Inc.
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 84562164300..37f42be3f4d 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -159,7 +159,8 @@ To define items in any other map, use `tool-bar-local-item'."
((< (display-color-cells) 256)
',(list xpm-lo-spec xpm-spec pbm-spec xbm-spec))
(t
- ',(list xpm-spec pbm-spec xbm-spec))))))
+ ',(list xpm-spec pbm-spec xbm-spec)))
+ t)))
;;;###autoload
(defun tool-bar-local-item (icon def key map &rest props)
diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el
index 45d3f28ea07..e8a71a38df6 100644
--- a/lisp/tree-widget.el
+++ b/lisp/tree-widget.el
@@ -260,10 +260,9 @@ Typically it should contain something like this:
\\='(:ascent center :mask (heuristic t)))"
(or name (setq name (or tree-widget-theme "default")))
(unless (string-equal name (tree-widget-theme-name))
- (set (make-local-variable 'tree-widget--theme)
- (make-vector 4 nil))
- (tree-widget-set-parent-theme name)
- (tree-widget-set-parent-theme "default")))
+ (setq-local tree-widget--theme (make-vector 4 nil))
+ (tree-widget-set-parent-theme name)
+ (tree-widget-set-parent-theme "default")))
(defun tree-widget--locate-sub-directory (name path)
"Locate all occurrences of the sub-directory NAME in PATH.
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index d07737e3332..ca84f86f289 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -50,6 +50,9 @@
"Tutorial language.")
(make-variable-buffer-local 'tutorial--lang)
+(defvar tutorial--buffer nil
+ "The selected tutorial buffer.")
+
(defun tutorial--describe-nonstandard-key (value)
"Give more information about a changed key binding.
This is used in `help-with-tutorial'. The information includes
@@ -655,6 +658,15 @@ with some explanatory links."
(unless (eq prop-val 'key-sequence)
(delete-region prop-start prop-end))))))
+(defun tutorial--save-on-kill ()
+ "Query the user about saving the tutorial when killing Emacs."
+ (when (buffer-live-p tutorial--buffer)
+ (with-current-buffer tutorial--buffer
+ (if (y-or-n-p "Save your position in the tutorial? ")
+ (tutorial--save-tutorial-to (tutorial--saved-file))
+ (message "Tutorial position not saved"))))
+ t)
+
(defun tutorial--save-tutorial ()
"Save the tutorial buffer.
This saves the part of the tutorial before and after the area
@@ -802,6 +814,7 @@ Run the Viper tutorial? "))
;; (Re)build the tutorial buffer if it is not ok
(unless old-tut-is-ok
(switch-to-buffer (get-buffer-create tut-buf-name))
+ (setq tutorial--buffer (current-buffer))
;; (unless old-tut-buf (text-mode))
(unless lang (error "Variable lang is nil"))
(setq tutorial--lang lang)
@@ -814,6 +827,7 @@ Run the Viper tutorial? "))
;; a hook to save it when the buffer is killed.
(setq buffer-auto-save-file-name nil)
(add-hook 'kill-buffer-hook 'tutorial--save-tutorial nil t)
+ (add-hook 'kill-emacs-query-functions 'tutorial--save-on-kill)
;; Insert the tutorial. First offer to resume last tutorial
;; editing session.
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index bee3a6b85e4..e185a7914f3 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -162,7 +162,7 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
";; version-control: never\n"
";; no-byte-compile: t\n"
";; End:\n")
- (set (make-local-variable 'version-control) 'never)
+ (setq-local version-control 'never)
(write-file fname))
(setq url-cookies-changed-since-last-save nil))))
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 75330d33277..1271b9b96f5 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -741,12 +741,12 @@ should be shown to the user."
;; without changing the API. Instead url-retrieve should
;; either simply not return the "destination" buffer, or it
;; should take an optional `dest-buf' argument.
- (set (make-local-variable 'url-redirect-buffer)
- (url-retrieve-internal
- redirect-uri url-callback-function
- url-callback-arguments
- (url-silent url-current-object)
- (not (url-use-cookies url-current-object))))
+ (setq-local url-redirect-buffer
+ (url-retrieve-internal
+ redirect-uri url-callback-function
+ url-callback-arguments
+ (url-silent url-current-object)
+ (not (url-use-cookies url-current-object))))
(url-mark-buffer-as-dead buffer))
;; We hit url-max-redirections, so issue an error and
;; stop redirecting.
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 0a7e7e205e0..bd9543bbe75 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -574,8 +574,8 @@ Has a preference for looking backward when not directly on a symbol."
(save-excursion
(goto-char (point-min))
(unless url-current-mime-headers
- (set (make-local-variable 'url-current-mime-headers)
- (mail-header-extract)))))
+ (setq-local url-current-mime-headers
+ (mail-header-extract)))))
(defun url-make-private-file (file)
"Make FILE only readable and writable by the current user.
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 08640fcece9..580d48880bd 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -465,6 +465,9 @@ are two possible targets for this %spatch. However, these files do not exist."
file1 file2 (if multi-patch-p "multi-" ""))))
(princ "
\nPlease enter an alternative patch target ...\n"))
+ (when (and (string= file1 file2)
+ (y-or-n-p (format "Create %s?" file1)))
+ (write-region (point-min) (point-min) file1))
(let ((directory t)
target)
(while directory
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index feafe5f5f0a..5f978daec02 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -387,7 +387,8 @@ The first subexpression is the actual text of the field.")
nil lax))
("^\n"
(progn (goto-char (match-end 0)) (1+ (match-end 0))) nil
- (0 '(:height 0.1 :inverse-video t :extend t))))
+ (0 '(face (:height 0.1 :inverse-video t :extend t)
+ display-line-numbers-disable t rear-nonsticky t))))
(log-edit--match-first-line (0 'log-edit-summary))))
(defvar log-edit-font-lock-gnu-style nil
@@ -490,6 +491,9 @@ commands (under C-x v for VC, for example).
\\{log-edit-mode-map}"
(setq-local font-lock-defaults '(log-edit-font-lock-keywords t))
+ (make-local-variable 'font-lock-extra-managed-props)
+ (cl-pushnew 'rear-nonsticky font-lock-extra-managed-props)
+ (cl-pushnew 'display-line-numbers-disable font-lock-extra-managed-props)
(setq-local jit-lock-contextually t) ;For the "first line is summary".
(setq-local fill-paragraph-function #'log-edit-fill-entry)
(make-local-variable 'log-edit-comment-ring-index)
@@ -983,16 +987,17 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
(visiting-buffer (find-buffer-visiting file)))
;; If there is a buffer visiting FILE, and it has a local
;; value for `change-log-default-name', use that.
- (if (and visiting-buffer
+ (or (and visiting-buffer
(local-variable-p 'change-log-default-name
- visiting-buffer))
- (with-current-buffer visiting-buffer
- change-log-default-name)
- ;; `find-change-log' uses `change-log-default-name' if set
- ;; and sets it before exiting, so we need to work around
- ;; that memoizing which is undesired here.
- (setq change-log-default-name nil)
- (find-change-log)))))
+ visiting-buffer)
+ (with-current-buffer visiting-buffer
+ change-log-default-name))
+ ;; `find-change-log' uses `change-log-default-name' if set
+ ;; and sets it before exiting, so we need to work around
+ ;; that memoizing which is undesired here.
+ (progn
+ (setq change-log-default-name nil)
+ (find-change-log))))))
(when (or (find-buffer-visiting changelog-file-name)
(file-exists-p changelog-file-name)
add-log-dont-create-changelog-file)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 0da4509670a..84c964e7f52 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -72,7 +72,7 @@
;; by git, so it's probably
;; not a good idea.
;; - merge-news (file) see `merge-file'
-;; - mark-resolved (file) OK
+;; - mark-resolved (files) OK
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index e7f67e90eef..c8a80d75ec1 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -276,13 +276,12 @@ If `ask', you will be prompted for a branch type."
((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
(t 'up-to-date))))))
-(defun vc-hg-working-revision (file)
+(defun vc-hg-working-revision (_file)
"Hg-specific version of `vc-working-revision'."
- (or (ignore-errors
- (with-output-to-string
- (vc-hg-command standard-output 0 file
- "parent" "--template" "{rev}")))
- "0"))
+ (ignore-errors
+ (with-output-to-string
+ (vc-hg-command standard-output 0 nil
+ "log" "-r" "." "--template" "{rev}"))))
(defcustom vc-hg-symbolic-revision-styles
'(builtin-active-bookmark
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index f268f912fe7..7d9af00de7c 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -201,7 +201,7 @@
;;
;; STATE-CHANGING FUNCTIONS
;;
-;; * create-repo (backend)
+;; * create-repo ()
;;
;; Create an empty repository in the current directory and initialize
;; it so VC mode can add files to it. For file-oriented systems, this
@@ -275,7 +275,7 @@
;; If FILE is in the `added' state it should be returned to the
;; `unregistered' state.
;;
-;; - merge-file (file rev1 rev2)
+;; - merge-file (file &optional rev1 rev2)
;;
;; Merge the changes between REV1 and REV2 into the current working
;; file (for non-distributed VCS). It is expected that with an
@@ -333,19 +333,19 @@
;; the case). Not all backends support this. At present, this is
;; only ever used with LIMIT = 1 (by vc-annotate-show-log-revision-at-line).
;;
-;; * log-outgoing (backend remote-location)
+;; * log-outgoing (buffer remote-location)
;;
;; Insert in BUFFER the revision log for the changes that will be
;; sent when performing a push operation to REMOTE-LOCATION.
;;
-;; * log-incoming (backend remote-location)
+;; * log-incoming (buffer remote-location)
;;
;; Insert in BUFFER the revision log for the changes that will be
;; received when performing a pull operation from REMOTE-LOCATION.
;;
-;; - log-search (pattern)
+;; - log-search (buffer pattern)
;;
-;; Search for PATTERN in the revision log.
+;; Search for PATTERN in the revision log and output results into BUFFER.
;;
;; - log-view-mode ()
;;
@@ -478,7 +478,7 @@
;;
;; Return the root of the VC controlled hierarchy for file.
;;
-;; - ignore (file &optional directory)
+;; - ignore (file &optional directory remove)
;;
;; Ignore FILE under DIRECTORY (default is 'default-directory').
;; FILE is a file wildcard relative to DIRECTORY.
@@ -487,7 +487,7 @@
;; When called from Lisp code, if DIRECTORY is non-nil, the
;; repository to use will be deduced by DIRECTORY.
;;
-;; - ignore-completion-table
+;; - ignore-completion-table (directory)
;;
;; Return the completion table for files ignored by the current
;; version control system, e.g., the entries in `.gitignore' and
@@ -2325,7 +2325,8 @@ checked out in that new branch."
;; to ask for a directory, branches are created at repository level.
default-directory
(read-directory-name "Directory: " default-directory default-directory t))
- (read-string (if current-prefix-arg "New branch name: " "New tag name: "))
+ (read-string (if current-prefix-arg "New branch name: " "New tag name: ")
+ nil 'vc-revision-history)
current-prefix-arg)))
(message "Making %s... " (if branchp "branch" "tag"))
(when (file-directory-p dir) (setq dir (file-name-as-directory dir)))
diff --git a/lisp/wdired.el b/lisp/wdired.el
index ebe19613943..b7dd4ee9496 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -242,12 +242,12 @@ See `wdired-mode'."
(interactive)
(unless (derived-mode-p 'dired-mode)
(error "Not a Dired buffer"))
- (set (make-local-variable 'wdired-old-content)
- (buffer-substring (point-min) (point-max)))
- (set (make-local-variable 'wdired-old-marks)
- (dired-remember-marks (point-min) (point-max)))
- (set (make-local-variable 'wdired-old-point) (point))
- (set (make-local-variable 'query-replace-skip-read-only) t)
+ (setq-local wdired-old-content
+ (buffer-substring (point-min) (point-max)))
+ (setq-local wdired-old-marks
+ (dired-remember-marks (point-min) (point-max)))
+ (setq-local wdired-old-point (point))
+ (setq-local query-replace-skip-read-only t)
(add-function :after-while (local 'isearch-filter-predicate)
#'wdired-isearch-filter-read-only)
(use-local-map wdired-mode-map)
@@ -390,7 +390,7 @@ non-nil means return old filename."
(dired-advertise)
(remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
(remove-hook 'after-change-functions 'wdired--restore-properties t)
- (set (make-local-variable 'revert-buffer-function) 'dired-revert))
+ (setq-local revert-buffer-function 'dired-revert))
(defun wdired-abort-changes ()
@@ -834,7 +834,7 @@ Like original function but it skips read-only words."
;; original name and permissions as a property
(defun wdired-preprocess-perms ()
(let ((inhibit-read-only t))
- (set (make-local-variable 'wdired-col-perm) nil)
+ (setq-local wdired-col-perm nil)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 02ee7bcf7fd..814f3e5a5f6 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1986,13 +1986,13 @@ resultant list will be returned."
;; prepare local hooks
(add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
;; create whitespace local buffer environment
- (set (make-local-variable 'whitespace-font-lock-keywords) nil)
- (set (make-local-variable 'whitespace-display-table) nil)
- (set (make-local-variable 'whitespace-display-table-was-local) nil)
- (set (make-local-variable 'whitespace-active-style)
- (if (listp whitespace-style)
- whitespace-style
- (list whitespace-style)))
+ (setq-local whitespace-font-lock-keywords nil)
+ (setq-local whitespace-display-table nil)
+ (setq-local whitespace-display-table-was-local nil)
+ (setq-local whitespace-active-style
+ (if (listp whitespace-style)
+ whitespace-style
+ (list whitespace-style)))
;; turn on whitespace
(when whitespace-active-style
(whitespace-color-on)
@@ -2034,19 +2034,14 @@ resultant list will be returned."
"Turn on color visualization."
(when (whitespace-style-face-p)
;; save current point and refontify when necessary
- (set (make-local-variable 'whitespace-point)
- (point))
+ (setq-local whitespace-point (point))
(setq whitespace-point--used
(let ((ol (make-overlay (point) (point) nil nil t)))
(delete-overlay ol) ol))
- (set (make-local-variable 'whitespace-font-lock-refontify)
- 0)
- (set (make-local-variable 'whitespace-bob-marker)
- (point-min-marker))
- (set (make-local-variable 'whitespace-eob-marker)
- (point-max-marker))
- (set (make-local-variable 'whitespace-buffer-changed)
- nil)
+ (setq-local whitespace-font-lock-refontify 0)
+ (setq-local whitespace-bob-marker (point-min-marker))
+ (setq-local whitespace-eob-marker (point-max-marker))
+ (setq-local whitespace-buffer-changed nil)
(add-hook 'post-command-hook #'whitespace-post-command-hook nil t)
(add-hook 'before-change-functions #'whitespace-buffer-changed nil t)
;; Add whitespace-mode color into font lock.
diff --git a/lisp/window.el b/lisp/window.el
index daa5c67df8b..67c3992c3f9 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -8390,9 +8390,9 @@ from the list of completions and default values."
;; here manually.
(if (and (boundp 'icomplete-with-completion-tables)
(listp icomplete-with-completion-tables))
- (set (make-local-variable 'icomplete-with-completion-tables)
- (cons rbts-completion-table
- icomplete-with-completion-tables))))
+ (setq-local icomplete-with-completion-tables
+ (cons rbts-completion-table
+ icomplete-with-completion-tables))))
(read-buffer prompt (other-buffer (current-buffer))
(confirm-nonexistent-file-or-buffer)))))
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index caf57ae43fe..9d502d772bd 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -451,7 +451,7 @@ function findactiveelement(doc){
XW is the xwidget identifier, TEXT is retrieved from the webkit."
(switch-to-buffer
(generate-new-buffer "textarea"))
- (set (make-local-variable 'xwidget-xwbl) xw)
+ (setq-local xwidget-xwbl xw)
(insert text))
(defun xwidget-webkit-end-edit-textarea ()
diff --git a/lwlib/lwlib-utils.c b/lwlib/lwlib-utils.c
index f15cb603a80..2b3aa55c3e6 100644
--- a/lwlib/lwlib-utils.c
+++ b/lwlib/lwlib-utils.c
@@ -148,6 +148,7 @@ XftFont *
crxft_font_open_name (Display *dpy, int screen, const char *name)
{
XftFont *pub = NULL;
+ FcPattern *match = NULL;
FcPattern *pattern = FcNameParse ((FcChar8 *) name);
if (pattern)
{
@@ -162,12 +163,18 @@ crxft_font_open_name (Display *dpy, int screen, const char *name)
FcPatternAddDouble (pattern, FC_DPI, dpi);
}
FcDefaultSubstitute (pattern);
+ FcResult result;
+ match = FcFontMatch (NULL, pattern, &result);
+ FcPatternDestroy (pattern);
+ }
+ if (match)
+ {
cairo_font_face_t *font_face
- = cairo_ft_font_face_create_for_pattern (pattern);
+ = cairo_ft_font_face_create_for_pattern (match);
if (font_face)
{
double pixel_size;
- if ((FcPatternGetDouble (pattern, FC_PIXEL_SIZE, 0, &pixel_size)
+ if ((FcPatternGetDouble (match, FC_PIXEL_SIZE, 0, &pixel_size)
!= FcResultMatch)
|| pixel_size < 1)
pixel_size = 10;
@@ -177,7 +184,7 @@ crxft_font_open_name (Display *dpy, int screen, const char *name)
cairo_matrix_init_scale (&font_matrix, pixel_size, pixel_size);
cairo_matrix_init_identity (&ctm);
cairo_font_options_t *options = cairo_font_options_create ();
- cairo_ft_font_options_substitute (options, pattern);
+ cairo_ft_font_options_substitute (options, match);
pub->scaled_font = cairo_scaled_font_create (font_face, &font_matrix,
&ctm, options);
cairo_font_face_destroy (font_face);
@@ -190,7 +197,7 @@ crxft_font_open_name (Display *dpy, int screen, const char *name)
pub->height = lround (extents.height);
pub->max_advance_width = lround (extents.max_x_advance);
}
- FcPatternDestroy (pattern);
+ FcPatternDestroy (match);
}
if (pub && pub->height <= 0)
{
diff --git a/src/charset.c b/src/charset.c
index 520dd3a9605..f6b5173fad4 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -800,7 +800,9 @@ RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
characters contained in CHARSET.
The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
-range of code points (in CHARSET) of target characters. */)
+range of code points (in CHARSET) of target characters. Note that
+these are not character codes, but code points in CHARSET; for the
+difference see `decode-char' and `list-charset-chars'. */)
(Lisp_Object function, Lisp_Object charset, Lisp_Object arg, Lisp_Object from_code, Lisp_Object to_code)
{
struct charset *cs;
diff --git a/src/chartab.c b/src/chartab.c
index cb2ced568d9..331e8595ebe 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -1000,10 +1000,10 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
"mapping table" or a "deunifier table" of a certain charset.
If CHARSET is not NULL (this is the case that `map-charset-chars'
- is called with non-nil FROM-CODE and TO-CODE), it is a charset who
- owns TABLE, and the function is called only on a character in the
+ is called with non-nil FROM-CODE and TO-CODE), it is a charset that
+ owns TABLE, and the function is called only for characters in the
range FROM and TO. FROM and TO are not character codes, but code
- points of a character in CHARSET.
+ points of characters in CHARSET (see 'decode-char').
This function is called in these two cases:
diff --git a/src/data.c b/src/data.c
index 384c2592204..76bacf7e131 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1639,8 +1639,9 @@ default_value (Lisp_Object symbol)
DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
doc: /* Return t if SYMBOL has a non-void default value.
-This is the value that is seen in buffers that do not have their own values
-for this variable. */)
+A variable may have a buffer-local or a `let'-bound local value. This
+function says whether the variable has a non-void value outside of the
+current context. Also see `default-value'. */)
(Lisp_Object symbol)
{
register Lisp_Object value;
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 0f3ef59fd8c..b7cd835c83c 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -784,7 +784,8 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t len)
MODULE_FUNCTION_BEGIN (NULL);
if (! (0 <= len && len <= STRING_BYTES_BOUND))
overflow_error ();
- Lisp_Object lstr = module_decode_utf_8 (str, len);
+ Lisp_Object lstr
+ = len == 0 ? empty_multibyte_string : module_decode_utf_8 (str, len);
return lisp_to_value (env, lstr);
}
@@ -794,9 +795,8 @@ module_make_unibyte_string (emacs_env *env, const char *str, ptrdiff_t length)
MODULE_FUNCTION_BEGIN (NULL);
if (! (0 <= length && length <= STRING_BYTES_BOUND))
overflow_error ();
- Lisp_Object lstr = make_uninit_string (length);
- memcpy (SDATA (lstr), str, length);
- SDATA (lstr)[length] = 0;
+ Lisp_Object lstr
+ = length == 0 ? empty_unibyte_string : make_unibyte_string (str, length);
return lisp_to_value (env, lstr);
}
diff --git a/src/emacs.c b/src/emacs.c
index d0e65ce2e80..00d3fc25abe 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2380,10 +2380,13 @@ all of which are called before Emacs is actually killed. */
/* Fsignal calls emacs_abort () if it sees that waiting_for_input is
set. */
waiting_for_input = 0;
- if (noninteractive)
- safe_run_hooks (Qkill_emacs_hook);
- else
- run_hook (Qkill_emacs_hook);
+ if (!NILP (find_symbol_value (Qkill_emacs_hook)))
+ {
+ if (noninteractive)
+ safe_run_hooks (Qkill_emacs_hook);
+ else
+ call1 (Qrun_hook_query_error_with_timeout, Qkill_emacs_hook);
+ }
#ifdef HAVE_X_WINDOWS
/* Transfer any clipboards we own to the clipboard manager. */
@@ -2905,6 +2908,8 @@ syms_of_emacs (void)
DEFSYM (Qrisky_local_variable, "risky-local-variable");
DEFSYM (Qkill_emacs, "kill-emacs");
DEFSYM (Qkill_emacs_hook, "kill-emacs-hook");
+ DEFSYM (Qrun_hook_query_error_with_timeout,
+ "run-hook-query-error-with-timeout");
#ifdef HAVE_UNEXEC
defsubr (&Sdump_emacs);
diff --git a/src/eval.c b/src/eval.c
index d9a424b57a9..e2d70aaa0ef 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1709,6 +1709,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
break;
}
+ bool debugger_called = false;
if (/* Don't run the debugger for a memory-full error.
(There is no room in memory to do that!) */
!NILP (error_symbol)
@@ -1722,7 +1723,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
if requested". */
|| EQ (h->tag_or_ch, Qerror)))
{
- bool debugger_called
+ debugger_called
= maybe_call_debugger (conditions, error_symbol, data);
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
@@ -1730,6 +1731,19 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
return Qnil;
}
+ /* If we're in batch mode, print a backtrace unconditionally to help with
+ debugging. Make sure to use `debug' unconditionally to not interfere with
+ ERT or other packages that install custom debuggers. */
+ if (!debugger_called && !NILP (error_symbol)
+ && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) && noninteractive
+ && backtrace_on_error_noninteractive)
+ {
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (Vdebugger, Qdebug);
+ call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
+ unbind_to (count, Qnil);
+ }
+
if (!NILP (clause))
{
Lisp_Object unwind_data
@@ -4251,6 +4265,14 @@ Note that `debug-on-error', `debug-on-quit' and friends
still determine whether to handle the particular condition. */);
Vdebug_on_signal = Qnil;
+ DEFVAR_BOOL ("backtrace-on-error-noninteractive",
+ backtrace_on_error_noninteractive,
+ doc: /* Non-nil means print backtrace on error in batch mode.
+If this is nil, errors in batch mode will just print the error
+message upon encountering an unhandled error, without showing
+the Lisp backtrace. */);
+ backtrace_on_error_noninteractive = true;
+
/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
again when this is still equal to num_nonmacro_input_events, then we
diff --git a/src/fileio.c b/src/fileio.c
index 283813ff89e..702c1438283 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -3757,9 +3757,10 @@ characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
If optional fifth argument REPLACE is non-nil, replace the current
buffer contents (in the accessible portion) with the file contents.
This is better than simply deleting and inserting the whole thing
-because (1) it preserves some marker positions and (2) it puts less data
-in the undo list. When REPLACE is non-nil, the second return value is
-the number of characters that replace previous buffer contents.
+because (1) it preserves some marker positions (in unchanged portions
+at the start and end of the buffer) and (2) it puts less data in the
+undo list. When REPLACE is non-nil, the second return value is the
+number of characters that replace previous buffer contents.
This function does code conversion according to the value of
`coding-system-for-read' or `file-coding-system-alist', and sets the
diff --git a/src/fns.c b/src/fns.c
index e4c9acc3163..646c3ed0834 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4525,16 +4525,34 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
EMACS_UINT
hash_string (char const *ptr, ptrdiff_t len)
{
- char const *p = ptr;
- char const *end = p + len;
- unsigned char c;
- EMACS_UINT hash = 0;
+ EMACS_UINT const *p = (EMACS_UINT const *) ptr;
+ EMACS_UINT const *end = (EMACS_UINT const *) (ptr + len);
+ EMACS_UINT hash = len;
+ /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course,
+ * but dividing by 8 is cheaper. */
+ ptrdiff_t step = 1 + ((end - p) >> 3);
- while (p != end)
+ /* Beware: `end` might be unaligned, so `p < end` is not always the same
+ * as `p <= end - 1`. */
+ while (p <= end - 1)
{
- c = *p++;
+ EMACS_UINT c = *p;
+ p += step;
hash = sxhash_combine (hash, c);
}
+ if (p < end)
+ { /* A few last bytes remain (smaller than an EMACS_UINT). */
+ /* FIXME: We could do this without a loop, but it'd require
+ endian-dependent code :-( */
+ char const *p1 = (char const *)p;
+ char const *end1 = (char const *)end;
+ do
+ {
+ unsigned char c = *p1++;
+ hash = sxhash_combine (hash, c);
+ }
+ while (p1 < end1);
+ }
return hash;
}
@@ -5418,7 +5436,8 @@ disregarding any coding systems. If nil, use the current buffer.
This function is useful for comparing two buffers running in the same
Emacs, but is not guaranteed to return the same hash between different
-Emacs versions.
+Emacs versions. It should be somewhat more efficient on larger
+buffers than `secure-hash' is, and should not allocate more memory.
It should not be used for anything security-related. See
`secure-hash' for these applications. */ )
@@ -5551,6 +5570,40 @@ Case is always significant and text properties are ignored. */)
return make_int (string_byte_to_char (haystack, res - SSDATA (haystack)));
}
+
+static void
+collect_interval (INTERVAL interval, Lisp_Object collector)
+{
+ nconc2 (collector,
+ list1(list3 (make_fixnum (interval->position),
+ make_fixnum (interval->position + LENGTH (interval)),
+ interval->plist)));
+}
+
+DEFUN ("object-intervals", Fobject_intervals, Sobject_intervals, 1, 1, 0,
+ doc: /* Return a copy of the text properties of OBJECT.
+OBJECT must be a buffer or a string.
+
+Altering this copy does not change the layout of the text properties
+in OBJECT. */)
+ (register Lisp_Object object)
+{
+ Lisp_Object collector = Fcons (Qnil, Qnil);
+ INTERVAL intervals;
+
+ if (STRINGP (object))
+ intervals = string_intervals (object);
+ else if (BUFFERP (object))
+ intervals = buffer_intervals (XBUFFER (object));
+ else
+ wrong_type_argument (Qbuffer_or_string_p, object);
+
+ if (! intervals)
+ return Qnil;
+
+ traverse_intervals (intervals, 0, collect_interval, collector);
+ return CDR (collector);
+}
void
@@ -5592,6 +5645,7 @@ syms_of_fns (void)
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
defsubr (&Sstring_search);
+ defsubr (&Sobject_intervals);
/* Crypto and hashing stuff. */
DEFSYM (Qiv_auto, "iv-auto");
diff --git a/src/frame.c b/src/frame.c
index a67ec4772a8..a827eaa81e8 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3580,7 +3580,9 @@ window managers may refuse to honor a HEIGHT that is not an integer
multiple of the default frame font height.
When called interactively, HEIGHT is the numeric prefix and the
-currently selected frame will be set to this height. */)
+currently selected frame will be set to this height.
+
+If FRAME is nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
@@ -3603,7 +3605,9 @@ window managers may refuse to honor a WIDTH that is not an integer
multiple of the default frame font width.
When called interactively, WIDTH is the numeric prefix and the
-currently selected frame will be set to this width. */)
+currently selected frame will be set to this width.
+
+If FRAME is nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
@@ -3619,7 +3623,9 @@ Optional argument PIXELWISE non-nil means to measure in pixels. Note:
When `frame-resize-pixelwise' is nil, some window managers may refuse to
honor a WIDTH that is not an integer multiple of the default frame font
width or a HEIGHT that is not an integer multiple of the default frame
-font height. */)
+font height.
+
+If FRAME is nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
diff --git a/src/image.c b/src/image.c
index e2d142ed32e..e2a3902b26c 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1703,17 +1703,6 @@ make_image_cache (void)
return c;
}
-/* Compare two lists (one of which must be proper), comparing each
- element with `eq'. */
-static bool
-equal_lists (Lisp_Object a, Lisp_Object b)
-{
- while (CONSP (a) && CONSP (b) && EQ (XCAR (a), XCAR (b)))
- a = XCDR (a), b = XCDR (b);
-
- return EQ (a, b);
-}
-
/* Find an image matching SPEC in the cache, and return it. If no
image is found, return NULL. */
static struct image *
@@ -1741,7 +1730,7 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash,
for (img = c->buckets[i]; img; img = img->next)
if (img->hash == hash
- && equal_lists (img->spec, spec)
+ && !NILP (Fequal (img->spec, spec))
&& (ignore_colors || (img->face_foreground == foreground
&& img->face_background == background)))
break;
@@ -1755,12 +1744,13 @@ static void
uncache_image (struct frame *f, Lisp_Object spec)
{
struct image *img;
+ EMACS_UINT hash = sxhash (spec);
/* Because the background colors are based on the current face, we
can have multiple copies of an image with the same spec. We want
to remove them all to ensure the user doesn't see an old version
of the image when the face changes. */
- while ((img = search_image_cache (f, spec, sxhash (spec), 0, 0, true)))
+ while ((img = search_image_cache (f, spec, hash, 0, 0, true)))
{
free_image (f, img);
/* As display glyphs may still be referring to the image ID, we
@@ -1913,6 +1903,55 @@ which is then usually a filename. */)
return Qnil;
}
+static size_t
+image_frame_cache_size (struct frame *f)
+{
+ size_t total = 0;
+#if defined USE_CAIRO
+ struct image_cache *c = FRAME_IMAGE_CACHE (f);
+
+ if (!c)
+ return 0;
+
+ for (ptrdiff_t i = 0; i < c->used; ++i)
+ {
+ struct image *img = c->images[i];
+
+ if (img && img->pixmap && img->pixmap != NO_PIXMAP)
+ total += img->pixmap->width * img->pixmap->height *
+ img->pixmap->bits_per_pixel / 8;
+ }
+#elif defined HAVE_NTGUI
+ struct image_cache *c = FRAME_IMAGE_CACHE (f);
+
+ if (!c)
+ return 0;
+
+ for (ptrdiff_t i = 0; i < c->used; ++i)
+ {
+ struct image *img = c->images[i];
+
+ if (img && img->pixmap && img->pixmap != NO_PIXMAP)
+ total += w32_image_size (img);
+ }
+#endif
+ return total;
+}
+
+DEFUN ("image-cache-size", Fimage_cache_size, Simage_cache_size, 0, 0, 0,
+ doc: /* Return the size of the image cache. */)
+ (void)
+{
+ Lisp_Object tail, frame;
+ size_t total = 0;
+
+ FOR_EACH_FRAME (tail, frame)
+ if (FRAME_WINDOW_P (XFRAME (frame)))
+ total += image_frame_cache_size (XFRAME (frame));
+
+ return make_int (total);
+}
+
DEFUN ("image-flush", Fimage_flush, Simage_flush,
1, 2, 0,
@@ -9571,6 +9610,7 @@ enum svg_keyword_index
SVG_TYPE,
SVG_DATA,
SVG_FILE,
+ SVG_BASE_URI,
SVG_ASCENT,
SVG_MARGIN,
SVG_RELIEF,
@@ -9590,6 +9630,7 @@ static const struct image_keyword svg_format[SVG_LAST] =
{":type", IMAGE_SYMBOL_VALUE, 1},
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
+ {":base-uri", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
@@ -9662,6 +9703,9 @@ DEF_DLL_FN (gboolean, rsvg_handle_write,
DEF_DLL_FN (gboolean, rsvg_handle_close, (RsvgHandle *, GError **));
# endif
+DEF_DLL_FN (void, rsvg_handle_set_dpi_x_y,
+ (RsvgHandle * handle, double dpi_x, double dpi_y));
+
# if LIBRSVG_CHECK_VERSION (2, 46, 0)
DEF_DLL_FN (void, rsvg_handle_get_intrinsic_dimensions,
(RsvgHandle *, gboolean *, RsvgLength *, gboolean *,
@@ -9718,6 +9762,7 @@ init_svg_functions (void)
LOAD_DLL_FN (library, rsvg_handle_write);
LOAD_DLL_FN (library, rsvg_handle_close);
#endif
+ LOAD_DLL_FN (library, rsvg_handle_set_dpi_x_y);
#if LIBRSVG_CHECK_VERSION (2, 46, 0)
LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions);
LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer);
@@ -9773,6 +9818,7 @@ init_svg_functions (void)
# undef rsvg_handle_set_base_uri
# undef rsvg_handle_write
# endif
+# undef rsvg_handle_set_dpi_x_y
# define gdk_pixbuf_get_bits_per_sample fn_gdk_pixbuf_get_bits_per_sample
# define gdk_pixbuf_get_colorspace fn_gdk_pixbuf_get_colorspace
@@ -9806,6 +9852,7 @@ init_svg_functions (void)
# define rsvg_handle_set_base_uri fn_rsvg_handle_set_base_uri
# define rsvg_handle_write fn_rsvg_handle_write
# endif
+# define rsvg_handle_set_dpi_x_y fn_rsvg_handle_set_dpi_x_y
# endif /* !WINDOWSNT */
@@ -9816,10 +9863,11 @@ static bool
svg_load (struct frame *f, struct image *img)
{
bool success_p = 0;
- Lisp_Object file_name;
+ Lisp_Object file_name, base_uri;
/* If IMG->spec specifies a file name, create a non-file spec from it. */
file_name = image_spec_value (img->spec, QCfile, NULL);
+ base_uri = image_spec_value (img->spec, QCbase_uri, NULL);
if (STRINGP (file_name))
{
int fd;
@@ -9839,15 +9887,16 @@ svg_load (struct frame *f, struct image *img)
return 0;
}
/* If the file was slurped into memory properly, parse it. */
- success_p = svg_load_image (f, img, contents, size,
- SSDATA (ENCODE_FILE (file)));
+ if (!STRINGP (base_uri))
+ base_uri = ENCODE_FILE (file);
+ success_p = svg_load_image (f, img, contents, size, SSDATA (base_uri));
xfree (contents);
}
/* Else it's not a file, it's a Lisp object. Load the image from a
Lisp object rather than a file. */
else
{
- Lisp_Object data, original_filename;
+ Lisp_Object data;
data = image_spec_value (img->spec, QCdata, NULL);
if (!STRINGP (data))
@@ -9855,10 +9904,10 @@ svg_load (struct frame *f, struct image *img)
image_error ("Invalid image data `%s'", data);
return 0;
}
- original_filename = BVAR (current_buffer, filename);
+ if (!STRINGP (base_uri))
+ base_uri = BVAR (current_buffer, filename);
success_p = svg_load_image (f, img, SSDATA (data), SBYTES (data),
- (NILP (original_filename) ? NULL
- : SSDATA (original_filename)));
+ (NILP (base_uri) ? NULL : SSDATA (base_uri)));
}
return success_p;
@@ -9866,11 +9915,8 @@ svg_load (struct frame *f, struct image *img)
#if LIBRSVG_CHECK_VERSION (2, 46, 0)
static double
-svg_css_length_to_pixels (RsvgLength length)
+svg_css_length_to_pixels (RsvgLength length, double dpi)
{
- /* FIXME: 96 appears to be a pretty standard DPI but we should
- probably use the real DPI if we can get it. */
- double dpi = 96;
double value = length.length;
switch (length.unit)
@@ -9944,18 +9990,26 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
rsvg_handle = rsvg_handle_new_from_stream_sync (input_stream, base_file,
RSVG_HANDLE_FLAGS_NONE,
NULL, &err);
+
if (base_file)
g_object_unref (base_file);
g_object_unref (input_stream);
/* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */
if (!rsvg_handle || err) goto rsvg_error;
+
+ rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
+ FRAME_DISPLAY_INFO (f)->resy);
#else
/* Make a handle to a new rsvg object. */
rsvg_handle = rsvg_handle_new ();
eassume (rsvg_handle);
+ rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
+ FRAME_DISPLAY_INFO (f)->resy);
+
/* Set base_uri for properly handling referenced images (via 'href').
+ Can be explicitly specified using `:base_uri' image property.
See rsvg bug 596114 - "image refs are relative to curdir, not .svg file"
. */
if (filename)
@@ -9978,6 +10032,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
/* Try the instrinsic dimensions first. */
gboolean has_width, has_height, has_viewbox;
RsvgLength iwidth, iheight;
+ double dpi = FRAME_DISPLAY_INFO (f)->resx;
rsvg_handle_get_intrinsic_dimensions (rsvg_handle,
&has_width, &iwidth,
@@ -9987,19 +10042,19 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
if (has_width && has_height)
{
/* Success! We can use these values directly. */
- viewbox_width = svg_css_length_to_pixels (iwidth);
- viewbox_height = svg_css_length_to_pixels (iheight);
+ viewbox_width = svg_css_length_to_pixels (iwidth, dpi);
+ viewbox_height = svg_css_length_to_pixels (iheight, dpi);
}
else if (has_width && has_viewbox)
{
- viewbox_width = svg_css_length_to_pixels (iwidth);
- viewbox_height = svg_css_length_to_pixels (iwidth)
+ viewbox_width = svg_css_length_to_pixels (iwidth, dpi);
+ viewbox_height = svg_css_length_to_pixels (iwidth, dpi)
* viewbox.width / viewbox.height;
}
else if (has_height && has_viewbox)
{
- viewbox_height = svg_css_length_to_pixels (iheight);
- viewbox_width = svg_css_length_to_pixels (iheight)
+ viewbox_height = svg_css_length_to_pixels (iheight, dpi);
+ viewbox_width = svg_css_length_to_pixels (iheight, dpi)
* viewbox.height / viewbox.width;
}
else if (has_viewbox)
@@ -10108,18 +10163,26 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
rsvg_handle = rsvg_handle_new_from_stream_sync (input_stream, base_file,
RSVG_HANDLE_FLAGS_NONE,
NULL, &err);
+
if (base_file)
g_object_unref (base_file);
g_object_unref (input_stream);
/* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */
if (!rsvg_handle || err) goto rsvg_error;
+
+ rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
+ FRAME_DISPLAY_INFO (f)->resy);
#else
/* Make a handle to a new rsvg object. */
rsvg_handle = rsvg_handle_new ();
eassume (rsvg_handle);
+ rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
+ FRAME_DISPLAY_INFO (f)->resy);
+
/* Set base_uri for properly handling referenced images (via 'href').
+ Can be explicitly specified using `:base_uri' image property.
See rsvg bug 596114 - "image refs are relative to curdir, not .svg file"
. */
if (filename)
@@ -10802,6 +10865,7 @@ non-numeric, there is no explicit limit on the size of images. */);
#if defined (HAVE_RSVG)
DEFSYM (Qsvg, "svg");
+ DEFSYM (QCbase_uri, ":base-uri");
add_image_type (Qsvg);
#ifdef HAVE_NTGUI
/* Other libraries used directly by svg code. */
@@ -10831,6 +10895,7 @@ non-numeric, there is no explicit limit on the size of images. */);
defsubr (&Simage_size);
defsubr (&Simage_mask_p);
defsubr (&Simage_metadata);
+ defsubr (&Simage_cache_size);
#ifdef GLYPH_DEBUG
defsubr (&Simagep);
diff --git a/src/keyboard.c b/src/keyboard.c
index 6605419c5c7..e8d0747210a 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -384,11 +384,13 @@ next_kbd_event (union buffered_input_event *ptr)
return ptr == kbd_buffer + KBD_BUFFER_SIZE - 1 ? kbd_buffer : ptr + 1;
}
+#ifdef HAVE_X11
static union buffered_input_event *
prev_kbd_event (union buffered_input_event *ptr)
{
return ptr == kbd_buffer ? kbd_buffer + KBD_BUFFER_SIZE - 1 : ptr - 1;
}
+#endif
/* Like EVENT_START, but assume EVENT is an event.
This pacifies gcc -Wnull-dereference, which might otherwise
@@ -741,9 +743,6 @@ void
force_auto_save_soon (void)
{
last_auto_save = - auto_save_interval - 1;
- /* FIXME: What's the relationship between forcing auto-save and adding
- a buffer-switch event? */
- record_asynch_buffer_change ();
}
#endif
@@ -3431,8 +3430,7 @@ readable_events (int flags)
&& event->ie.part == scroll_bar_handle
&& event->ie.modifiers == 0)
#endif
- && !((flags & READABLE_EVENTS_FILTER_EVENTS)
- && event->kind == BUFFER_SWITCH_EVENT))
+ )
return 1;
event = next_kbd_event (event);
}
@@ -3583,12 +3581,6 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
return;
}
}
- /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
- Just ignore the second one. */
- else if (event->kind == BUFFER_SWITCH_EVENT
- && kbd_fetch_ptr != kbd_store_ptr
- && prev_kbd_event (kbd_store_ptr)->kind == BUFFER_SWITCH_EVENT)
- return;
/* Don't let the very last slot in the buffer become full,
since that would make the two pointers equal,
@@ -3622,7 +3614,6 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
case ICONIFY_EVENT: ignore_event = Qiconify_frame; break;
case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break;
case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break;
- case BUFFER_SWITCH_EVENT: ignore_event = Qbuffer_switch; break;
default: ignore_event = Qnil; break;
}
@@ -3964,7 +3955,6 @@ kbd_buffer_get_event (KBOARD **kbp,
#ifdef HAVE_XWIDGETS
case XWIDGET_EVENT:
#endif
- case BUFFER_SWITCH_EVENT:
case SAVE_SESSION_EVENT:
case NO_EVENT:
case HELP_EVENT:
@@ -5344,14 +5334,6 @@ make_lispy_event (struct input_event *event)
return list2 (Qmove_frame, list1 (event->frame_or_window));
#endif
- case BUFFER_SWITCH_EVENT:
- {
- /* The value doesn't matter here; only the type is tested. */
- Lisp_Object obj;
- XSETBUFFER (obj, current_buffer);
- return obj;
- }
-
/* Just discard these, by returning nil.
With MULTI_KBOARD, these events are used as placeholders
when we need to randomly delete events from the queue.
@@ -6813,41 +6795,6 @@ get_input_pending (int flags)
return input_pending;
}
-/* Put a BUFFER_SWITCH_EVENT in the buffer
- so that read_key_sequence will notice the new current buffer. */
-
-void
-record_asynch_buffer_change (void)
-{
- /* We don't need a buffer-switch event unless Emacs is waiting for input.
- The purpose of the event is to make read_key_sequence look up the
- keymaps again. If we aren't in read_key_sequence, we don't need one,
- and the event could cause trouble by messing up (input-pending-p).
- Note: Fwaiting_for_user_input_p always returns nil when async
- subprocesses aren't supported. */
- if (!NILP (Fwaiting_for_user_input_p ()))
- {
- struct input_event event;
-
- EVENT_INIT (event);
- event.kind = BUFFER_SWITCH_EVENT;
- event.frame_or_window = Qnil;
- event.arg = Qnil;
-
- /* Make sure no interrupt happens while storing the event. */
-#ifdef USABLE_SIGIO
- if (interrupt_input)
- kbd_buffer_store_event (&event);
- else
-#endif
- {
- stop_polling ();
- kbd_buffer_store_event (&event);
- start_polling ();
- }
- }
-}
-
/* Read any terminal input already buffered up by the system
into the kbd_buffer, but do not wait.
@@ -11581,8 +11528,6 @@ syms_of_keyboard (void)
/* Menu and tool bar item parts. */
DEFSYM (Qmenu_enable, "menu-enable");
- DEFSYM (Qbuffer_switch, "buffer-switch");
-
#ifdef HAVE_NTGUI
DEFSYM (Qlanguage_change, "language-change");
DEFSYM (Qend_session, "end-session");
diff --git a/src/keyboard.h b/src/keyboard.h
index 41da3a6bf44..24e9a007888 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -446,7 +446,6 @@ extern void push_kboard (struct kboard *);
extern void push_frame_kboard (struct frame *);
extern void pop_kboard (void);
extern void temporarily_switch_to_single_kboard (struct frame *);
-extern void record_asynch_buffer_change (void);
extern void input_poll_signal (int);
extern void start_polling (void);
extern void stop_polling (void);
diff --git a/src/lisp.h b/src/lisp.h
index 416c9b0cac1..e83304462fa 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1897,16 +1897,17 @@ ASCII_CHAR_P (intmax_t c)
return 0 <= c && c < 0x80;
}
-/* A char-table is a kind of vectorlike, with contents are like a
- vector but with a few other slots. For some purposes, it makes
- sense to handle a char-table with type struct Lisp_Vector. An
- element of a char table can be any Lisp objects, but if it is a sub
- char-table, we treat it a table that contains information of a
- specific range of characters. A sub char-table is like a vector but
- with two integer fields between the header and Lisp data, which means
+/* A char-table is a kind of vectorlike, with contents like a vector,
+ but with a few additional slots. For some purposes, it makes sense
+ to handle a char-table as type 'struct Lisp_Vector'. An element of
+ a char-table can be any Lisp object, but if it is a sub-char-table,
+ we treat it as a table that contains information of a specific
+ range of characters. A sub-char-table is like a vector, but with
+ two integer fields between the header and Lisp data, which means
that it has to be marked with some precautions (see mark_char_table
- in alloc.c). A sub char-table appears only in an element of a char-table,
- and there's no way to access it directly from Emacs Lisp program. */
+ in alloc.c). A sub-char-table appears only in an element of a
+ char-table, and there's no way to access it directly from a Lisp
+ program. */
enum CHARTAB_SIZE_BITS
{
@@ -1926,11 +1927,11 @@ struct Lisp_Char_Table
contents, and extras slots. */
union vectorlike_header header;
- /* This holds a default value,
- which is used whenever the value for a specific character is nil. */
+ /* This holds the default value, which is used whenever the value
+ for a specific character is nil. */
Lisp_Object defalt;
- /* This points to another char table, which we inherit from when the
+ /* This points to another char table, from which we inherit when the
value for a specific character is nil. The `defalt' slot takes
precedence over this. */
Lisp_Object parent;
@@ -1939,8 +1940,8 @@ struct Lisp_Char_Table
meant for. */
Lisp_Object purpose;
- /* The bottom sub char-table for characters of the range 0..127. It
- is nil if none of ASCII character has a specific value. */
+ /* The bottom sub char-table for characters in the range 0..127. It
+ is nil if no ASCII character has a specific value. */
Lisp_Object ascii;
Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)];
@@ -2015,7 +2016,7 @@ CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx)
}
/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
- characters. Do not check validity of CT. */
+ characters. Does not check validity of CT. */
INLINE Lisp_Object
CHAR_TABLE_REF (Lisp_Object ct, int idx)
{
@@ -2025,7 +2026,7 @@ CHAR_TABLE_REF (Lisp_Object ct, int idx)
}
/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
- 8-bit European characters. Do not check validity of CT. */
+ 8-bit European characters. Does not check validity of CT. */
INLINE void
CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
{
diff --git a/src/nsterm.m b/src/nsterm.m
index 0729c961bdf..7972fa4dabb 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -1166,7 +1166,6 @@ ns_update_end (struct frame *f)
{
#endif
[NSGraphicsContext setCurrentContext:nil];
- [view setNeedsDisplay:YES];
#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
else
@@ -3056,7 +3055,7 @@ ns_clear_under_internal_border (struct frame *f)
if (!face)
return;
- ns_focus (f, &frame_rect, 1);
+ ns_focus (f, NULL, 1);
[ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
for (int i = 0; i < 4 ; i++)
{
@@ -4987,8 +4986,8 @@ ns_set_vertical_scroll_bar (struct window *window,
[bar removeFromSuperview];
wset_vertical_scroll_bar (window, Qnil);
[bar release];
+ ns_clear_frame_area (f, left, top, width, height);
}
- ns_clear_frame_area (f, left, top, width, height);
unblock_input ();
return;
}
@@ -5010,7 +5009,7 @@ ns_set_vertical_scroll_bar (struct window *window,
r.size.width = oldRect.size.width;
if (FRAME_LIVE_P (f) && !NSEqualRects (oldRect, r))
{
- if (oldRect.origin.x != r.origin.x)
+ if (! NSEqualRects (oldRect, r))
ns_clear_frame_area (f, left, top, width, height);
[bar setFrame: r];
}
@@ -5088,8 +5087,7 @@ ns_set_horizontal_scroll_bar (struct window *window,
oldRect = [bar frame];
if (FRAME_LIVE_P (f) && !NSEqualRects (oldRect, r))
{
- if (oldRect.origin.y != r.origin.y)
- ns_clear_frame_area (f, left, top, width, height);
+ ns_clear_frame_area (f, left, top, width, height);
[bar setFrame: r];
update_p = YES;
}
diff --git a/src/process.c b/src/process.c
index 9926993fae9..b2d94d8f8a8 100644
--- a/src/process.c
+++ b/src/process.c
@@ -5328,19 +5328,9 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
do
{
unsigned old_timers_run = timers_run;
- struct buffer *old_buffer = current_buffer;
- Lisp_Object old_window = selected_window;
timer_delay = timer_check ();
- /* If a timer has run, this might have changed buffers
- an alike. Make read_key_sequence aware of that. */
- if (timers_run != old_timers_run
- && (old_buffer != current_buffer
- || !EQ (old_window, selected_window))
- && waiting_for_user_input_p == -1)
- record_asynch_buffer_change ();
-
if (timers_run != old_timers_run && do_display)
/* We must retry, since a timer may have requeued itself
and that could alter the time_delay. */
@@ -5698,9 +5688,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (read_kbd != 0)
{
- unsigned old_timers_run = timers_run;
- struct buffer *old_buffer = current_buffer;
- Lisp_Object old_window = selected_window;
bool leave = false;
if (detect_input_pending_run_timers (do_display))
@@ -5710,14 +5697,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
leave = true;
}
- /* If a timer has run, this might have changed buffers
- an alike. Make read_key_sequence aware of that. */
- if (timers_run != old_timers_run
- && waiting_for_user_input_p == -1
- && (old_buffer != current_buffer
- || !EQ (old_window, selected_window)))
- record_asynch_buffer_change ();
-
if (leave)
break;
}
@@ -6217,18 +6196,6 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
/* Restore waiting_for_user_input_p as it was
when we were called, in case the filter clobbered it. */
waiting_for_user_input_p = waiting;
-
-#if 0 /* Call record_asynch_buffer_change unconditionally,
- because we might have changed minor modes or other things
- that affect key bindings. */
- if (! EQ (Fcurrent_buffer (), obuffer)
- || ! EQ (current_buffer->keymap, okeymap))
-#endif
- /* But do it only if the caller is actually going to read events.
- Otherwise there's no need to make him wake up, and it could
- cause trouble (for example it would make sit_for return). */
- if (waiting_for_user_input_p == -1)
- record_asynch_buffer_change ();
}
DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
@@ -7394,16 +7361,6 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
when we were called, in case the filter clobbered it. */
waiting_for_user_input_p = waiting;
-#if 0
- if (! EQ (Fcurrent_buffer (), obuffer)
- || ! EQ (current_buffer->keymap, okeymap))
-#endif
- /* But do it only if the caller is actually going to read events.
- Otherwise there's no need to make him wake up, and it could
- cause trouble (for example it would make sit_for return). */
- if (waiting_for_user_input_p == -1)
- record_asynch_buffer_change ();
-
unbind_to (count, Qnil);
}
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 971a5f63749..904ca0c7b95 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -3575,9 +3575,11 @@ skip_noops (re_char *p, re_char *pend)
opcode. When the function finishes, *PP will be advanced past that opcode.
C is character to test (possibly after translations) and CORIG is original
character (i.e. without any translations). UNIBYTE denotes whether c is
- unibyte or multibyte character. */
+ unibyte or multibyte character.
+ CANON_TABLE is the canonicalisation table for case folding or Qnil. */
static bool
-execute_charset (re_char **pp, int c, int corig, bool unibyte)
+execute_charset (re_char **pp, int c, int corig, bool unibyte,
+ Lisp_Object canon_table)
{
eassume (0 <= c && 0 <= corig);
re_char *p = *pp, *rtp = NULL;
@@ -3617,11 +3619,9 @@ execute_charset (re_char **pp, int c, int corig, bool unibyte)
(class_bits & BIT_BLANK && ISBLANK (c)) ||
(class_bits & BIT_WORD && ISWORD (c)) ||
((class_bits & BIT_UPPER) &&
- (ISUPPER (c) || (corig != c &&
- c == downcase (corig) && ISLOWER (c)))) ||
+ (ISUPPER (corig) || (!NILP (canon_table) && ISLOWER (corig)))) ||
((class_bits & BIT_LOWER) &&
- (ISLOWER (c) || (corig != c &&
- c == upcase (corig) && ISUPPER(c)))) ||
+ (ISLOWER (corig) || (!NILP (canon_table) && ISUPPER (corig)))) ||
(class_bits & BIT_PUNCT && ISPUNCT (c)) ||
(class_bits & BIT_GRAPH && ISGRAPH (c)) ||
(class_bits & BIT_PRINT && ISPRINT (c)))
@@ -3696,7 +3696,8 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1,
else if ((re_opcode_t) *p1 == charset
|| (re_opcode_t) *p1 == charset_not)
{
- if (!execute_charset (&p1, c, c, !multibyte || ASCII_CHAR_P (c)))
+ if (!execute_charset (&p1, c, c, !multibyte || ASCII_CHAR_P (c),
+ Qnil))
{
DEBUG_PRINT (" No match => fast loop.\n");
return true;
@@ -4367,7 +4368,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
}
p -= 1;
- if (!execute_charset (&p, c, corig, unibyte_char))
+ if (!execute_charset (&p, c, corig, unibyte_char, translate))
goto fail;
d += len;
diff --git a/src/termhooks.h b/src/termhooks.h
index c28c3fbbd02..276b0687e6f 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -160,7 +160,6 @@ enum event_kind
SELECTION_REQUEST_EVENT, /* Another X client wants a selection from us.
See `struct selection_input_event'. */
SELECTION_CLEAR_EVENT, /* Another X client cleared our selection. */
- BUFFER_SWITCH_EVENT, /* A process filter has switched buffers. */
DELETE_WINDOW_EVENT, /* An X client said "delete this window". */
#ifdef HAVE_NTGUI
END_SESSION_EVENT, /* The user is logging out or shutting down. */
diff --git a/src/thread.h b/src/thread.h
index a09929fa440..9697e49f09f 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -140,7 +140,6 @@ struct thread_state
for user-input when that process-filter was called.
waiting_for_input cannot be used as that is by definition 0 when
lisp code is being evalled.
- This is also used in record_asynch_buffer_change.
For that purpose, this must be 0
when not inside wait_reading_process_output. */
int m_waiting_for_user_input_p;
diff --git a/src/w32gui.h b/src/w32gui.h
index dfec1f08617..fc8131130fb 100644
--- a/src/w32gui.h
+++ b/src/w32gui.h
@@ -46,6 +46,7 @@ extern int w32_load_image (struct frame *f, struct image *img,
Lisp_Object spec_file, Lisp_Object spec_data);
extern bool w32_can_use_native_image_api (Lisp_Object);
extern void w32_gdiplus_shutdown (void);
+extern size_t w32_image_size (struct image *);
#define FACE_DEFAULT (~0)
diff --git a/src/w32term.c b/src/w32term.c
index 23cb380040b..a038e4593f4 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -1991,6 +1991,17 @@ w32_draw_image_foreground (struct glyph_string *s)
RestoreDC (s->hdc ,-1);
}
+size_t
+w32_image_size (struct image *img)
+{
+ BITMAP bm_info;
+ size_t rv = 0;
+
+ if (GetObject (img->pixmap, sizeof (BITMAP), &bm_info))
+ rv = bm_info.bmWidth * bm_info.bmHeight * bm_info.bmBitsPixel / 8;
+ return rv;
+}
+
/* Draw a relief around the image glyph string S. */
@@ -4847,10 +4858,6 @@ w32_read_socket (struct terminal *terminal,
inev.kind = DEICONIFY_EVENT;
XSETFRAME (inev.frame_or_window, f);
}
- else if (!NILP (Vframe_list) && !NILP (XCDR (Vframe_list)))
- /* Force a redisplay sooner or later to update the
- frame titles in case this is the second frame. */
- record_asynch_buffer_change ();
}
else
{
@@ -5468,12 +5475,6 @@ w32_read_socket (struct terminal *terminal,
inev.kind = DEICONIFY_EVENT;
XSETFRAME (inev.frame_or_window, f);
}
- else if (! NILP (Vframe_list)
- && ! NILP (XCDR (Vframe_list)))
- /* Force a redisplay sooner or later
- to update the frame titles
- in case this is the second frame. */
- record_asynch_buffer_change ();
/* Windows can send us a SIZE_MAXIMIZED message even
when fullscreen is fullboth. The following is a
@@ -5521,12 +5522,6 @@ w32_read_socket (struct terminal *terminal,
inev.kind = DEICONIFY_EVENT;
XSETFRAME (inev.frame_or_window, f);
}
- else if (! NILP (Vframe_list)
- && ! NILP (XCDR (Vframe_list)))
- /* Force a redisplay sooner or later
- to update the frame titles
- in case this is the second frame. */
- record_asynch_buffer_change ();
}
if (EQ (get_frame_param (f, Qfullscreen), Qmaximized))
@@ -5818,9 +5813,6 @@ w32_read_socket (struct terminal *terminal,
SET_FRAME_GARBAGED (f);
DebPrint (("obscured frame %p (%s) found to be visible\n",
f, SDATA (f->name)));
-
- /* Force a redisplay sooner or later. */
- record_asynch_buffer_change ();
}
}
}
diff --git a/src/window.c b/src/window.c
index 6cd3122b43b..8e75e460b2b 100644
--- a/src/window.c
+++ b/src/window.c
@@ -5669,7 +5669,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
if (whole)
{
ptrdiff_t start_pos = IT_CHARPOS (it);
- int dy = frame_line_height;
+ int flh = frame_line_height;
int ht = window_box_height (w);
int nscls = sanitize_next_screen_context_lines ();
/* In the below we divide the window box height by the frame's
@@ -5677,14 +5677,37 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
box is not an integral multiple of the line height. This is
important to ensure we get back to the same position when
scrolling up, then down. */
- dy = n * max (dy, (ht / dy - nscls) * dy);
+ int dy = n * max (flh, (ht / flh - nscls) * flh);
+ int goal_y;
+ void *it_data;
/* Note that move_it_vertically always moves the iterator to the
start of a line. So, if the last line doesn't have a newline,
we would end up at the start of the line ending at ZV. */
if (dy <= 0)
{
+ goal_y = it.current_y - dy;
move_it_vertically_backward (&it, -dy);
+ /* Extra precision for people who want us to preserve the
+ screen position of the cursor: effectively round DY to the
+ nearest screen line, instead of rounding to zero; the latter
+ causes point to move by one line after C-v followed by M-v,
+ if the buffer has lines of different height. */
+ if (!NILP (Vscroll_preserve_screen_position)
+ && it.current_y - goal_y > 0.5 * flh)
+ {
+ it_data = bidi_shelve_cache ();
+ struct it it2 = it;
+
+ move_it_by_lines (&it, -1);
+ if (it.current_y < goal_y - 0.5 * flh)
+ {
+ it = it2;
+ bidi_unshelve_cache (it_data, false);
+ }
+ else
+ bidi_unshelve_cache (it_data, true);
+ }
/* Ensure we actually do move, e.g. in case we are currently
looking at an image that is taller that the window height. */
while (start_pos == IT_CHARPOS (it)
@@ -5693,8 +5716,25 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
}
else if (dy > 0)
{
- move_it_to (&it, ZV, -1, it.current_y + dy, -1,
- MOVE_TO_POS | MOVE_TO_Y);
+ goal_y = it.current_y + dy;
+ move_it_to (&it, ZV, -1, goal_y, -1, MOVE_TO_POS | MOVE_TO_Y);
+ /* See the comment above, for the reasons of this
+ extra-precision. */
+ if (!NILP (Vscroll_preserve_screen_position)
+ && goal_y - it.current_y > 0.5 * flh)
+ {
+ it_data = bidi_shelve_cache ();
+ struct it it2 = it;
+
+ move_it_by_lines (&it, 1);
+ if (it.current_y > goal_y + 0.5 * flh)
+ {
+ it = it2;
+ bidi_unshelve_cache (it_data, false);
+ }
+ else
+ bidi_unshelve_cache (it_data, true);
+ }
/* Ensure we actually do move, e.g. in case we are currently
looking at an image that is taller that the window height. */
while (start_pos == IT_CHARPOS (it)
@@ -8206,11 +8246,17 @@ is displayed in the `mode-line' face. */);
DEFVAR_LISP ("scroll-preserve-screen-position",
Vscroll_preserve_screen_position,
doc: /* Controls if scroll commands move point to keep its screen position unchanged.
+
A value of nil means point does not keep its screen position except
at the scroll margin or window boundary respectively.
+
A value of t means point keeps its screen position if the scroll
command moved it vertically out of the window, e.g. when scrolling
-by full screens.
+by full screens. If point is within `next-screen-context-lines' lines
+from the edges of the window, point will typically not keep its screen
+position when doing commands like `scroll-up-command'/`scroll-down-command'
+and the like.
+
Any other value means point always keeps its screen position.
Scroll commands should have the `scroll-command' property
on their symbols to be controlled by this variable. */);
diff --git a/src/xdisp.c b/src/xdisp.c
index 431d8111880..a8c66f017fc 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1925,12 +1925,12 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
/* If it3_moved stays false after the 'while' loop
below, that means we already were at a newline
before the loop (e.g., the display string begins
- with a newline), so we don't need to (and cannot)
- inspect the glyphs of it3.glyph_row, because
- PRODUCE_GLYPHS will not produce anything for a
- newline, and thus it3.glyph_row stays at its
- stale content it got at top of the window. */
+ with a newline), so we don't need to return to
+ the last position before the display string,
+ because PRODUCE_GLYPHS will not produce anything
+ for a newline. */
bool it3_moved = false;
+ int top_x_before_string = it3.current_x;
/* Finally, advance the iterator until we hit the
first display element whose character position is
CHARPOS, or until the first newline from the
@@ -1938,6 +1938,8 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
display line. */
while (get_next_display_element (&it3))
{
+ if (!EQ (it3.object, string))
+ top_x_before_string = it3.current_x;
PRODUCE_GLYPHS (&it3);
if (IT_CHARPOS (it3) == charpos
|| ITERATOR_AT_END_OF_LINE_P (&it3))
@@ -1952,32 +1954,26 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
if (!it3.line_number_produced_p)
{
if (it3.lnum_pixel_width > 0)
- top_x += it3.lnum_pixel_width;
+ {
+ top_x += it3.lnum_pixel_width;
+ top_x_before_string += it3.lnum_pixel_width;
+ }
else if (it.line_number_produced_p)
- top_x += it.lnum_pixel_width;
+ {
+ top_x += it.lnum_pixel_width;
+ top_x_before_string += it3.lnum_pixel_width;
+ }
}
/* Normally, we would exit the above loop because we
found the display element whose character
position is CHARPOS. For the contingency that we
didn't, and stopped at the first newline from the
- display string, move back over the glyphs
- produced from the string, until we find the
- rightmost glyph not from the string. */
+ display string, reset top_x to the coordinate of
+ the rightmost glyph not from the string. */
if (it3_moved
&& newline_in_string
&& IT_CHARPOS (it3) != charpos && EQ (it3.object, string))
- {
- struct glyph *g = it3.glyph_row->glyphs[TEXT_AREA]
- + it3.glyph_row->used[TEXT_AREA];
-
- while (EQ ((g - 1)->object, string))
- {
- --g;
- top_x -= g->pixel_width;
- }
- eassert (g < it3.glyph_row->glyphs[TEXT_AREA]
- + it3.glyph_row->used[TEXT_AREA]);
- }
+ top_x = top_x_before_string;
}
}
@@ -11755,9 +11751,10 @@ resize_mini_window (struct window *w, bool exact_p)
return false;
/* By default, start display at the beginning. */
- set_marker_both (w->start, w->contents,
- BUF_BEGV (XBUFFER (w->contents)),
- BUF_BEGV_BYTE (XBUFFER (w->contents)));
+ if (redisplay_adhoc_scroll_in_resize_mini_windows)
+ set_marker_both (w->start, w->contents,
+ BUF_BEGV (XBUFFER (w->contents)),
+ BUF_BEGV_BYTE (XBUFFER (w->contents)));
/* Nil means don't try to resize. */
if ((NILP (Vresize_mini_windows)
@@ -11816,27 +11813,32 @@ resize_mini_window (struct window *w, bool exact_p)
if (height > max_height)
{
height = (max_height / unit) * unit;
- init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID);
- move_it_vertically_backward (&it, height - unit);
- /* The following move is usually a no-op when the stuff
- displayed in the mini-window comes entirely from buffer
- text, but it is needed when some of it comes from overlay
- strings, especially when there's an after-string at ZV.
- This happens with some completion packages, like
- icomplete, ido-vertical, etc. With those packages, if we
- don't force w->start to be at the beginning of a screen
- line, important parts of the stuff in the mini-window,
- such as user prompt, will be hidden from view. */
- move_it_by_lines (&it, 0);
- start = it.current.pos;
- /* Prevent redisplay_window from recentering, and thus from
- overriding the window-start point we computed here. */
- w->start_at_line_beg = false;
+ if (redisplay_adhoc_scroll_in_resize_mini_windows)
+ {
+ init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID);
+ move_it_vertically_backward (&it, height - unit);
+ /* The following move is usually a no-op when the stuff
+ displayed in the mini-window comes entirely from buffer
+ text, but it is needed when some of it comes from overlay
+ strings, especially when there's an after-string at ZV.
+ This happens with some completion packages, like
+ icomplete, ido-vertical, etc. With those packages, if we
+ don't force w->start to be at the beginning of a screen
+ line, important parts of the stuff in the mini-window,
+ such as user prompt, will be hidden from view. */
+ move_it_by_lines (&it, 0);
+ start = it.current.pos;
+ /* Prevent redisplay_window from recentering, and thus from
+ overriding the window-start point we computed here. */
+ w->start_at_line_beg = false;
+ SET_MARKER_FROM_TEXT_POS (w->start, start);
+ }
}
else
- SET_TEXT_POS (start, BEGV, BEGV_BYTE);
-
- SET_MARKER_FROM_TEXT_POS (w->start, start);
+ {
+ SET_TEXT_POS (start, BEGV, BEGV_BYTE);
+ SET_MARKER_FROM_TEXT_POS (w->start, start);
+ }
if (EQ (Vresize_mini_windows, Qgrow_only))
{
@@ -35521,6 +35523,14 @@ The initial frame is not displayed anywhere, so skipping it is
best except in special circumstances such as running redisplay tests
in batch mode. */);
redisplay_skip_initial_frame = true;
+
+ DEFVAR_BOOL ("redisplay-adhoc-scroll-in-resize-mini-windows",
+ redisplay_adhoc_scroll_in_resize_mini_windows,
+ doc: /* If nil always use normal scrolling in minibuffer windows.
+Otherwise, use custom-tailored code after resizing minibuffer windows to try
+and display the most important part of the minibuffer. */);
+ /* See bug#43519 for some discussion around this. */
+ redisplay_adhoc_scroll_in_resize_mini_windows = true;
}
diff --git a/src/xterm.c b/src/xterm.c
index 0d2452de929..3de0d2e73c0 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -8383,10 +8383,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
inev.ie.kind = DEICONIFY_EVENT;
XSETFRAME (inev.ie.frame_or_window, f);
}
- else if (! NILP (Vframe_list) && ! NILP (XCDR (Vframe_list)))
- /* Force a redisplay sooner or later to update the
- frame titles in case this is the second frame. */
- record_asynch_buffer_change ();
}
goto OTHER;
diff --git a/test/README b/test/README
index d0da89d1c2c..3365f18cf7e 100644
--- a/test/README
+++ b/test/README
@@ -113,7 +113,8 @@ $EMACS_HYDRA_CI indicates the hydra environment, and $EMACS_EMBA_CI
indicates the emba environment, respectively.
-(Also, see etc/compilation.txt for compilation mode font lock tests.)
+(Also, see etc/compilation.txt for compilation mode font lock tests
+and etc/grep.txt for grep mode font lock tests.)
This file is part of GNU Emacs.
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index aaf1d4a5b5c..288ea1ae987 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -69,8 +69,9 @@
(define-abbrev ert-test-abbrevs "sys" "system abbrev" nil :system t)
(should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs))
'("a-e-t")))
- (should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs t))
- '("a-e-t" "sys")))))
+ (let ((syms (abbrev--table-symbols 'ert-test-abbrevs t)))
+ (should (equal (sort (mapcar #'symbol-name syms) #'string<)
+ '("a-e-t" "sys"))))))
(ert-deftest abbrev-table-get-put-test ()
(let ((table (make-abbrev-table)))
diff --git a/test/lisp/allout-tests.el b/test/lisp/allout-tests.el
index f7cd6db9cd4..c979d085c89 100644
--- a/test/lisp/allout-tests.el
+++ b/test/lisp/allout-tests.el
@@ -74,7 +74,7 @@
"Ensure that prior local value is resumed."
(with-temp-buffer
(allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
+ (setq-local allout-tests-locally-true t)
(cl-assert (not (default-boundp 'allout-tests-locally-true))
nil (concat "Test setup mistake -- variable supposed to"
" not have global binding, but it does."))
@@ -98,7 +98,7 @@
(allout-tests-obliterate-variable 'allout-tests-globally-true)
(setq allout-tests-globally-true t)
(allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
+ (setq-local allout-tests-locally-true t)
(allout-add-resumptions '(allout-tests-globally-unbound t)
'(allout-tests-globally-true nil)
'(allout-tests-locally-true nil))
@@ -135,7 +135,7 @@
(allout-tests-obliterate-variable 'allout-tests-globally-true)
(setq allout-tests-globally-true t)
(allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
+ (setq-local allout-tests-locally-true t)
(allout-add-resumptions '(allout-tests-globally-unbound t)
'(allout-tests-globally-true nil)
'(allout-tests-locally-true nil))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 8fa4d278f11..c2a3e3ba117 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -947,6 +947,75 @@ literals (Bug#20852)."
'((suspicious set-buffer))
"Warning: Use .with-current-buffer. rather than"))
+(ert-deftest bytecomp-tests--not-writable-directory ()
+ "Test that byte compilation works if the output directory isn't
+writable (Bug#44631)."
+ (let ((directory (make-temp-file "bytecomp-tests-" :directory)))
+ (unwind-protect
+ (let* ((input-file (expand-file-name "test.el" directory))
+ (output-file (expand-file-name "test.elc" directory))
+ (byte-compile-dest-file-function
+ (lambda (_) output-file))
+ (byte-compile-error-on-warn t))
+ (write-region "" nil input-file nil nil nil 'excl)
+ (write-region "" nil output-file nil nil nil 'excl)
+ (set-file-modes input-file #o400)
+ (set-file-modes output-file #o200)
+ (set-file-modes directory #o500)
+ (should (byte-compile-file input-file))
+ (should (file-regular-p output-file))
+ (should (cl-plusp (file-attribute-size
+ (file-attributes output-file)))))
+ (with-demoted-errors "Error cleaning up directory: %s"
+ (set-file-modes directory #o700)
+ (delete-directory directory :recursive)))))
+
+(ert-deftest bytecomp-tests--dest-mountpoint ()
+ "Test that byte compilation works if the destination file is a
+mountpoint (Bug#44631)."
+ (let ((bwrap (executable-find "bwrap"))
+ (emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless bwrap)
+ (skip-unless (file-executable-p bwrap))
+ (skip-unless (not (file-remote-p bwrap)))
+ (skip-unless (file-executable-p emacs))
+ (skip-unless (not (file-remote-p emacs)))
+ (let ((directory (make-temp-file "bytecomp-tests-" :directory)))
+ (unwind-protect
+ (let* ((input-file (expand-file-name "test.el" directory))
+ (output-file (expand-file-name "test.elc" directory))
+ (unquoted-file (file-name-unquote output-file))
+ (byte-compile-dest-file-function
+ (lambda (_) output-file))
+ (byte-compile-error-on-warn t))
+ (should-not (file-remote-p input-file))
+ (should-not (file-remote-p output-file))
+ (write-region "" nil input-file nil nil nil 'excl)
+ (write-region "" nil output-file nil nil nil 'excl)
+ (set-file-modes input-file #o400)
+ (set-file-modes output-file #o200)
+ (set-file-modes directory #o500)
+ (with-temp-buffer
+ (let ((status (call-process
+ bwrap nil t nil
+ "--ro-bind" "/" "/"
+ "--bind" unquoted-file unquoted-file
+ emacs "--quick" "--batch" "--load=bytecomp"
+ (format "--eval=%S"
+ `(setq byte-compile-dest-file-function
+ (lambda (_) ,output-file)
+ byte-compile-error-on-warn t))
+ "--funcall=batch-byte-compile" input-file)))
+ (unless (eql status 0)
+ (ert-fail `((status . ,status)
+ (output . ,(buffer-string)))))))
+ (should (file-regular-p output-file))
+ (should (cl-plusp (file-attribute-size
+ (file-attributes output-file)))))
+ (with-demoted-errors "Error cleaning up directory: %s"
+ (set-file-modes directory #o700)
+ (delete-directory directory :recursive))))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 8aae26a1aca..2c340c44408 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -97,7 +97,10 @@ back to the top level.")
;; sit-on interferes with keyboard macros.
(edebug-sit-on-break nil)
- (edebug-continue-kbd-macro t))
+ (edebug-continue-kbd-macro t)
+
+ ;; don't print backtraces, otherwise error messages don't match
+ (backtrace-on-error-noninteractive nil))
,@body))
(defmacro edebug-tests-with-normal-env (&rest body)
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 1f54c8d07e4..a0c56be0cb0 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -806,6 +806,16 @@ This macro is used to test if macroexpansion in `should' works."
:expected-result :failed ;; FIXME! Bug#11218
(should-not (with-demoted-errors (error "Foo"))))
+(ert-deftest ert-test-fail-inside-should ()
+ "Check that `ert-fail' inside `should' works correctly."
+ (let ((result (ert-run-test
+ (make-ert-test
+ :name 'test-1
+ :body (lambda () (should (integerp (ert-fail "Boo"))))))))
+ (should (ert-test-failed-p result))
+ (should (equal (ert-test-failed-condition result)
+ '(ert-test-failed ("Boo"))))))
+
(provide 'ert-tests)
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
index c77f2dc4990..6e9d50fc38f 100644
--- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
@@ -67,8 +67,8 @@ If `prog-mode' is defined, inherit from it."
(faceup-test-define-prog-mode faceup-test-mode "faceup-test"
"Dummy major mode for testing `faceup', a test system for font-lock."
- (set (make-local-variable 'syntax-propertize-function)
- #'faceup-test-syntax-propertize)
+ (setq-local syntax-propertize-function
+ #'faceup-test-syntax-propertize)
(setq font-lock-defaults '(faceup-test-font-lock-keywords nil)))
(provide 'faceup-test-mode)
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
index 29e4273b478..8fc6b514692 100644
--- a/test/lisp/emacs-lisp/gv-tests.el
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -83,7 +83,10 @@
(with-temp-buffer
(call-process (concat invocation-directory invocation-name)
nil '(t t) nil
- "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+ "-Q" "-batch"
+ "--eval" (prin1-to-string
+ `(let ((backtrace-on-error-noninteractive nil))
+ (byte-compile-file ,el)))
"-l" elc)
(should (equal (buffer-string)
"Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
@@ -133,8 +136,10 @@
"-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
"-l" elc
"--eval"
- (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
- (message "%d" (car gv-test-pair)))))
+ (prin1-to-string
+ '(let ((backtrace-on-error-noninteractive nil))
+ (setf (gv-test-foo gv-test-pair) 99)
+ (message "%d" (car gv-test-pair)))))
(should (string-match
"\\`Symbol.s function definition is void: \\\\(setf\\\\ gv-test-foo\\\\)\n\\'"
(buffer-string))))))
diff --git a/test/lisp/emacs-lisp/memory-report-tests.el b/test/lisp/emacs-lisp/memory-report-tests.el
new file mode 100644
index 00000000000..b67ec6c0103
--- /dev/null
+++ b/test/lisp/emacs-lisp/memory-report-tests.el
@@ -0,0 +1,57 @@
+;;; memory-report-tests.el --- tests for memory-report.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 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 .
+
+(require 'ert)
+(require 'memory-report)
+
+(defun setup-memory-report-tests ()
+ ;; Set the sizes on things based on a 64-bit architecture. (We're
+ ;; hard-coding this to be able to write simple tests that'll work on
+ ;; all architectures.)
+ (memory-report--set-size
+ '((conses 16 499173 99889)
+ (symbols 48 22244 3)
+ (strings 32 92719 4559)
+ (string-bytes 1 40402011)
+ (vectors 16 31919)
+ (vector-slots 8 385148 149240)
+ (floats 8 434 4519)
+ (intervals 56 24499 997)
+ (buffers 984 33))))
+
+(ert-deftest memory-report-sizes ()
+ (setup-memory-report-tests)
+ (should (equal (memory-report-object-size (cons nil nil)) 16))
+ (should (equal (memory-report-object-size (cons 1 2)) 16))
+
+ (should (equal (memory-report-object-size (list 1 2)) 32))
+ (should (equal (memory-report-object-size (list 1)) 16))
+
+ (should (equal (memory-report-object-size (list 'foo)) 16))
+
+ (should (equal (memory-report-object-size (vector 1 2 3 4)) 80))
+
+ (should (equal (memory-report-object-size "") 32))
+ (should (equal (memory-report-object-size "a") 33))
+ (should (equal (memory-report-object-size (propertize "a" 'face 'foo))
+ 81)))
+
+(provide 'memory-report-tests)
+
+;;; memory-report-tests.el ends here
diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el
index c9c92f529be..87d19e8b294 100644
--- a/test/lisp/epg-tests.el
+++ b/test/lisp/epg-tests.el
@@ -96,8 +96,7 @@
context
(ert-resource-file "seckey.asc")))
(with-temp-buffer
- (make-local-variable 'epg-tests-context)
- (setq epg-tests-context context)
+ (setq-local epg-tests-context context)
,@body))
(when (file-directory-p epg-tests-home-directory)
(delete-directory epg-tests-home-directory t)))))
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 268c3185bc6..25017dd3261 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -108,11 +108,8 @@ There are different timeouts for local and remote file notification libraries."
;; gio/gpollfilemonitor.c declares POLL_TIME_SECS 5. So we must
;; wait at least this time in the GPollFileMonitor case. A
;; similar timeout seems to be needed in the GFamFileMonitor case,
- ;; at least on Cygwin.
- ((and (string-equal (file-notify--test-library) "gfilenotify")
- (memq (file-notify--test-monitor)
- '(GFamFileMonitor GPollFileMonitor)))
- 7)
+ ;; at least on cygwin.
+ ((memq (file-notify--test-monitor) '(GFamFileMonitor GPollFileMonitor)) 7)
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe") 1)
((file-remote-p temporary-file-directory) 0.1)
(t 0.01))))
@@ -264,13 +261,19 @@ This returns only for the local case and gfilenotify; otherwise it is nil.
;; We cache the result, because after `file-notify-rm-watch',
;; `gfile-monitor-name' does not return a proper result anymore.
;; But we still need this information.
- (unless (file-remote-p temporary-file-directory)
- (or (cdr (assq file-notify--test-desc file-notify--test-monitors))
- (when (functionp 'gfile-monitor-name)
- (add-to-list 'file-notify--test-monitors
- (cons file-notify--test-desc
- (gfile-monitor-name file-notify--test-desc)))
- (cdr (assq file-notify--test-desc file-notify--test-monitors))))))
+ ;; So far, we know the monitors GFamFileMonitor, GFenFileMonitor,
+ ;; GInotifyFileMonitor, GKqueueFileMonitor and GPollFileMonitor.
+ (or (cdr (assq file-notify--test-desc file-notify--test-monitors))
+ (progn
+ (add-to-list
+ 'file-notify--test-monitors
+ (cons file-notify--test-desc
+ (if (file-remote-p temporary-file-directory)
+ (tramp-get-connection-property
+ file-notify--test-desc "gio-file-monitor" nil)
+ (and (functionp 'gfile-monitor-name)
+ (gfile-monitor-name file-notify--test-desc)))))
+ (cdr (assq file-notify--test-desc file-notify--test-monitors)))))
(defmacro file-notify--deftest-remote (test docstring &optional unstable)
"Define ert `TEST-remote' for remote files.
@@ -457,7 +460,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(unwind-protect
;; Check, that removing watch descriptors out of order do not
- ;; harm. This fails on Cygwin because of timing issues unless a
+ ;; harm. This fails on cygwin because of timing issues unless a
;; long `sit-for' is added before the call to
;; `file-notify--test-read-event'.
(unless (eq system-type 'cygwin)
@@ -631,13 +634,15 @@ delivered."
(cond
;; gvfs-monitor-dir on cygwin does not detect the
;; `created' event reliably.
- ((string-equal
- (file-notify--test-library) "gvfs-monitor-dir.exe")
+ ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(created deleted stopped)))
;; cygwin does not raise a `changed' event.
((eq system-type 'cygwin)
'(created deleted stopped))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created deleted stopped))
(t '(created changed deleted stopped)))
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
@@ -668,6 +673,9 @@ delivered."
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(changed deleted stopped)))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(deleted stopped))
;; There could be one or two `changed' events.
(t '((changed deleted stopped)
(changed changed deleted stopped))))
@@ -718,6 +726,9 @@ delivered."
'(created deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed deleted stopped))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created deleted deleted stopped))
(t '(created changed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -767,6 +778,9 @@ delivered."
;; directory are not detected.
((getenv "EMACS_EMBA_CI")
'(created changed created changed deleted deleted))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created created deleted deleted deleted stopped))
(t '(created changed created changed
deleted deleted deleted stopped)))
(write-region
@@ -823,6 +837,9 @@ delivered."
'(created created deleted deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed renamed deleted stopped))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created renamed deleted deleted stopped))
(t '(created changed renamed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -859,6 +876,8 @@ delivered."
((string-equal (file-notify--test-library) "w32notify")
'((changed changed)
(changed changed changed changed)))
+ ;; GKqueueFileMonitor does not report the `attribute-changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor) nil)
;; For kqueue and in the remote case, `write-region'
;; raises also an `attribute-changed' event.
((or (string-equal (file-notify--test-library) "kqueue")
@@ -925,6 +944,10 @@ delivered."
;; timeouts.
(setq file-notify--test-desc auto-revert-notify-watch-descriptor)
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ (skip-unless
+ (not (equal (file-notify--test-monitor) 'GKqueueFileMonitor)))
+
;; Check, that file notification has been used.
(should auto-revert-mode)
(should auto-revert-use-notify)
@@ -956,7 +979,7 @@ delivered."
;; Modify file. We wait for two seconds, in order to
;; have another timestamp. One second seems to be too
- ;; short. And Cygwin sporadically requires more than two.
+ ;; short. And cygwin sporadically requires more than two.
(ert-with-message-capture captured-messages
(let ((inhibit-message t))
(sleep-for (if (eq system-type 'cygwin) 3 2))
@@ -1028,6 +1051,9 @@ delivered."
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(changed deleted stopped)))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(deleted stopped))
;; There could be one or two `changed' events.
(t '((changed deleted stopped)
(changed changed deleted stopped))))
@@ -1077,6 +1103,9 @@ delivered."
'(created deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed deleted stopped))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created deleted deleted stopped))
(t '(created changed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -1254,9 +1283,12 @@ delivered."
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
(file-notify--test-with-actions
- ;; There could be one or two `changed' events.
- '((changed)
- (changed changed))
+ (cond
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor) nil)
+ ;; There could be one or two `changed' events.
+ (t '((changed)
+ (changed changed))))
;; There shouldn't be any problem, because the file is kept.
(with-temp-buffer
(let ((buffer-file-name file-notify--test-tmpfile)
@@ -1294,6 +1326,9 @@ delivered."
;; On cygwin we only get the `changed' event.
((eq system-type 'cygwin)
'(changed))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(renamed created))
(t '(renamed created changed)))
;; The file is renamed when creating a backup. It shall
;; still be watched.
@@ -1391,7 +1426,12 @@ the file watch."
(make-list (/ n 2) 'changed)
;; Just the directory monitor.
(make-list (/ n 2) 'created)
- (make-list (/ n 2) 'changed)))
+ (make-list (/ n 2) 'changed))
+ (append
+ '(:random)
+ ;; Just the directory monitor. GKqueueFileMonitor
+ ;; does not report the `changed' event.
+ (make-list (/ n 2) 'created)))
(dotimes (i n)
(file-notify--test-read-event)
(if (zerop (mod i 2))
diff --git a/test/lisp/net/rcirc-tests.el b/test/lisp/net/rcirc-tests.el
index 285926af9d2..cbd1c2be830 100644
--- a/test/lisp/net/rcirc-tests.el
+++ b/test/lisp/net/rcirc-tests.el
@@ -51,4 +51,16 @@
"MODE #cchan +kl :a:b"
nil "MODE" '("#cchan" "+kl" "a:b")))
+(ert-deftest rcirc-rename-nicks ()
+ (should (equal (rcirc--make-new-nick "foo" 16)
+ "foo`"))
+ (should (equal (rcirc--make-new-nick "123456789012345" 16)
+ "123456789012345`"))
+ (should (equal (rcirc--make-new-nick "1234567890123456" 16)
+ "123456789012345`"))
+ (should (equal (rcirc--make-new-nick "123456789012345`" 16)
+ "12345678901234``"))
+ (should (equal (rcirc--make-new-nick "123456789012````" 16)
+ "12345678901`````")))
+
;;; rcirc-tests.el ends here
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 7b88b8d531a..a2936cca824 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -439,8 +439,9 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; nil: Git Mtn
;; "0": Bzr CVS Hg SRC SVN
;; "1.1": RCS SCCS
+ ;; "-1": Hg versions before 5 (probably)
(message "vc-working-revision4 %s" (vc-working-revision tmp-name))
- (should (member (vc-working-revision tmp-name) '(nil "0" "1.1")))
+ (should (member (vc-working-revision tmp-name) '(nil "0" "1.1" "-1")))
;; TODO: Call `vc-checkin', and check the resulting
;; working revision. None of the return values should be
diff --git a/test/manual/indent/perl.perl b/test/manual/indent/perl.perl
index 853aec49245..6ec04303b4f 100755
--- a/test/manual/indent/perl.perl
+++ b/test/manual/indent/perl.perl
@@ -81,3 +81,17 @@ return 'W' if #/^Not Available on Mobile/m; #W=Web only
# A "y|abc|def|" shouldn't interfere when inside a string!
$toto = " x \" string\"";
$toto = " y \" string\""; # This is not the `y' operator!
+
+
+# Tricky cases from Harald Jörg
+$_ = "abcabc\n";
+s:abc:def:g; # FIXME: the initial s is fontified like a label, and indented
+
+s'def'ghi'g; # The middle ' should not end the quoting.
+s"ghi"ijk"g; # The middle ' should not end the quoting.
+
+s#ijk#lmn#g; # This is a regular expression sustitution.
+
+s #lmn#opq#g; # FIXME: this should be a comment starting with "#lmn"
+ /lmn/rst/g; # and this is the actual regular expression
+print; # prints "rstrst\n"
diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el
index 7abb79eadde..3eba4cfd78b 100644
--- a/test/src/casefiddle-tests.el
+++ b/test/src/casefiddle-tests.el
@@ -247,7 +247,8 @@
;; input upcase downcase [titlecase]
(dolist (test '((?a ?A ?a) (?A ?A ?a)
(?ł ?Ł ?ł) (?Ł ?Ł ?ł)
- (?ß ?ß ?ß) (?ẞ ?ẞ ?ß)
+ ;; We char-upcase ß to ẞ; see bug #11309.
+ (?ß ?ẞ ?ß) (?ẞ ?ẞ ?ß)
(?ⅷ ?Ⅷ ?ⅷ) (?Ⅷ ?Ⅷ ?ⅷ)
(?DŽ ?DŽ ?dž ?Dž) (?Dž ?DŽ ?dž ?Dž) (?dž ?DŽ ?dž ?Dž)))
(let ((ch (car test))
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 1312683c848..c5fc3eaa11a 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -324,7 +324,7 @@ comparing the subr with a much slower lisp implementation."
(defvar binding-test-some-local 'some)
(with-current-buffer binding-test-buffer-A
- (set (make-local-variable 'binding-test-some-local) 'local))
+ (setq-local binding-test-some-local 'local))
(ert-deftest binding-test-manual ()
"A test case from the elisp manual."
diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c
index f855e9b6da0..30ad352cf8b 100644
--- a/test/src/emacs-module-resources/mod-test.c
+++ b/test/src/emacs-module-resources/mod-test.c
@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */
#include
#include
+#include
#include
#include
#include
@@ -699,6 +700,34 @@ Fmod_test_funcall (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
return env->funcall (env, args[0], nargs - 1, args + 1);
}
+static emacs_value
+Fmod_test_make_string (emacs_env *env, ptrdiff_t nargs,
+ emacs_value *args, void *data)
+{
+ assert (nargs == 2);
+ intmax_t length_arg = env->extract_integer (env, args[0]);
+ if (env->non_local_exit_check (env) != emacs_funcall_exit_return)
+ return args[0];
+ if (length_arg < 0 || SIZE_MAX < length_arg)
+ {
+ signal_error (env, "Invalid string length");
+ return args[0];
+ }
+ size_t length = (size_t) length_arg;
+ bool multibyte = env->is_not_nil (env, args[1]);
+ char *buffer = length == 0 ? NULL : malloc (length);
+ if (buffer == NULL && length != 0)
+ {
+ memory_full (env);
+ return args[0];
+ }
+ memset (buffer, 'a', length);
+ emacs_value ret = multibyte ? env->make_string (env, buffer, length)
+ : env->make_unibyte_string (env, buffer, length);
+ free (buffer);
+ return ret;
+}
+
/* Lisp utilities for easier readability (simple wrappers). */
/* Provide FEATURE to Emacs. */
@@ -790,6 +819,7 @@ emacs_module_init (struct emacs_runtime *ert)
DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL);
DEFUN ("mod-test-funcall", Fmod_test_funcall, 1, emacs_variadic_function,
NULL, NULL);
+ DEFUN ("mod-test-make-string", Fmod_test_make_string, 2, 2, NULL, NULL);
#undef DEFUN
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 99d4cafb4af..bf26ffb935c 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -30,6 +30,7 @@
(require 'ert)
(require 'ert-x)
(require 'help-fns)
+(require 'subr-x)
(defconst mod-test-emacs
(expand-file-name invocation-name invocation-directory)
@@ -556,4 +557,23 @@ See Bug#36226."
(thread-join thread-1)
(thread-join thread-2)))
+(ert-deftest mod-test-make-string/empty ()
+ (dolist (multibyte '(nil t))
+ (ert-info ((format "Multibyte: %s" multibyte))
+ (let ((got (mod-test-make-string 0 multibyte)))
+ (should (stringp got))
+ (should (string-empty-p got))
+ (should (eq (multibyte-string-p got) multibyte))))))
+
+(ert-deftest mod-test-make-string/nonempty ()
+ (dolist (multibyte '(nil t))
+ (ert-info ((format "Multibyte: %s" multibyte))
+ (let ((first (mod-test-make-string 1 multibyte))
+ (second (mod-test-make-string 1 multibyte)))
+ (should (stringp first))
+ (should (eql (length first) 1))
+ (should (eq (multibyte-string-p first) multibyte))
+ (should (string-equal first second))
+ (should-not (eq first second))))))
+
;;; emacs-module-tests.el ends here
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index 074f5be1ef9..297db81f5ab 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -27,6 +27,7 @@
(require 'ert)
(eval-when-compile (require 'cl-lib))
+(require 'subr-x)
(ert-deftest eval-tests--bug24673 ()
"Check that Bug#24673 has been fixed."
@@ -176,4 +177,53 @@ in Common Lisp). Instead, make sure substitution in backquote
expressions works for identifiers starting with period."
(should (equal (let ((.x 'identity)) (eval `(,.x 'ok))) 'ok)))
+(ert-deftest eval-tests/backtrace-in-batch-mode ()
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless (file-executable-p emacs))
+ (with-temp-buffer
+ (let ((status (call-process emacs nil t nil
+ "--quick" "--batch"
+ (concat "--eval="
+ (prin1-to-string
+ '(progn
+ (defun foo () (error "Boo"))
+ (foo)))))))
+ (should (natnump status))
+ (should-not (eql status 0)))
+ (goto-char (point-min))
+ (ert-info ((concat "Process output:\n" (buffer-string)))
+ (search-forward " foo()")
+ (search-forward " normal-top-level()")))))
+
+(ert-deftest eval-tests/backtrace-in-batch-mode/inhibit ()
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless (file-executable-p emacs))
+ (with-temp-buffer
+ (let ((status (call-process
+ emacs nil t nil
+ "--quick" "--batch"
+ (concat "--eval="
+ (prin1-to-string
+ '(progn
+ (defun foo () (error "Boo"))
+ (let ((backtrace-on-error-noninteractive nil))
+ (foo))))))))
+ (should (natnump status))
+ (should-not (eql status 0)))
+ (should (equal (string-trim (buffer-string)) "Boo")))))
+
+(ert-deftest eval-tests/backtrace-in-batch-mode/demoted-errors ()
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless (file-executable-p emacs))
+ (with-temp-buffer
+ (should (eql 0 (call-process emacs nil t nil
+ "--quick" "--batch"
+ (concat "--eval="
+ (prin1-to-string
+ '(with-demoted-errors "Error: %S"
+ (error "Boo")))))))
+ (goto-char (point-min))
+ (should (equal (string-trim (buffer-string))
+ "Error: (error \"Boo\")")))))
+
;;; eval-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 86b8d655d26..eaa569e0d95 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -983,3 +983,19 @@
(should (equal (string-search (string-to-multibyte "o\303\270") "foo\303\270")
2))
(should (equal (string-search "\303\270" "foo\303\270") 3)))
+
+(ert-deftest object-intervals ()
+ (should (equal (object-intervals (propertize "foo" 'bar 'zot))
+ '((0 3 (bar zot)))))
+ (should (equal (object-intervals (concat (propertize "foo" 'bar 'zot)
+ (propertize "foo" 'gazonk "gazonk")))
+ '((0 3 (bar zot)) (3 6 (gazonk "gazonk")))))
+ (should (equal
+ (with-temp-buffer
+ (insert "foobar")
+ (put-text-property 1 3 'foo 1)
+ (put-text-property 3 6 'bar 2)
+ (put-text-property 2 5 'zot 3)
+ (object-intervals (current-buffer)))
+ '((0 1 (foo 1)) (1 2 (zot 3 foo 1)) (2 4 (zot 3 bar 2))
+ (4 5 (bar 2)) (5 6 nil)))))
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index f9372e37b11..34d4067db47 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -803,4 +803,68 @@ This evaluates the TESTS test cases from glibc."
(should-not (string-match "å" "\xe5"))
(should-not (string-match "[å]" "\xe5")))
+(ert-deftest regexp-case-fold ()
+ "Test case-sensitive and case-insensitive matching."
+ (let ((case-fold-search nil))
+ (should (equal (string-match "aB" "ABaB") 2))
+ (should (equal (string-match "åÄ" "ÅäåäÅÄåÄ") 6))
+ (should (equal (string-match "λΛ" "lΛλλΛ") 3))
+ (should (equal (string-match "шШ" "zШшшШ") 3))
+ (should (equal (string-match "[[:alpha:]]+" ".3aBåÄßλΛшШ中﷽") 2))
+ (should (equal (match-end 0) 12))
+ (should (equal (string-match "[[:alnum:]]+" ".3aBåÄßλΛшШ中﷽") 1))
+ (should (equal (match-end 0) 12))
+ (should (equal (string-match "[[:upper:]]+" ".3aåλшBÄΛШ中﷽") 6))
+ (should (equal (match-end 0) 10))
+ (should (equal (string-match "[[:lower:]]+" ".3BÄΛШaåλш中﷽") 6))
+ (should (equal (match-end 0) 10)))
+ (let ((case-fold-search t))
+ (should (equal (string-match "aB" "ABaB") 0))
+ (should (equal (string-match "åÄ" "ÅäåäÅÄåÄ") 0))
+ (should (equal (string-match "λΛ" "lΛλλΛ") 1))
+ (should (equal (string-match "шШ" "zШшшШ") 1))
+ (should (equal (string-match "[[:alpha:]]+" ".3aBåÄßλΛшШ中﷽") 2))
+ (should (equal (match-end 0) 12))
+ (should (equal (string-match "[[:alnum:]]+" ".3aBåÄßλΛшШ中﷽") 1))
+ (should (equal (match-end 0) 12))
+ (should (equal (string-match "[[:upper:]]+" ".3aåλшBÄΛШ中﷽") 2))
+ (should (equal (match-end 0) 10))
+ (should (equal (string-match "[[:lower:]]+" ".3BÄΛШaåλш中﷽") 2))
+ (should (equal (match-end 0) 10))))
+
+(ert-deftest regexp-eszett ()
+ "Test matching of ß and ẞ."
+ ;; Sanity checks.
+ (should (equal (upcase "ß") "SS"))
+ (should (equal (downcase "ß") "ß"))
+ (should (equal (capitalize "ß") "Ss")) ; undeutsch...
+ (should (equal (upcase "ẞ") "ẞ"))
+ (should (equal (downcase "ẞ") "ß"))
+ (should (equal (capitalize "ẞ") "ẞ"))
+ ;; ß is a lower-case letter (Ll); ẞ is an upper-case letter (Lu).
+ (let ((case-fold-search nil))
+ (should (equal (string-match "ß" "ß") 0))
+ (should (equal (string-match "ß" "ẞ") nil))
+ (should (equal (string-match "ẞ" "ß") nil))
+ (should (equal (string-match "ẞ" "ẞ") 0))
+ (should (equal (string-match "[[:alpha:]]" "ß") 0))
+ ;; bug#11309
+ (should (equal (string-match "[[:lower:]]" "ß") 0))
+ (should (equal (string-match "[[:upper:]]" "ß") nil))
+ (should (equal (string-match "[[:alpha:]]" "ẞ") 0))
+ (should (equal (string-match "[[:lower:]]" "ẞ") nil))
+ (should (equal (string-match "[[:upper:]]" "ẞ") 0)))
+ (let ((case-fold-search t))
+ (should (equal (string-match "ß" "ß") 0))
+ (should (equal (string-match "ß" "ẞ") 0))
+ (should (equal (string-match "ẞ" "ß") 0))
+ (should (equal (string-match "ẞ" "ẞ") 0))
+ (should (equal (string-match "[[:alpha:]]" "ß") 0))
+ ;; bug#11309
+ (should (equal (string-match "[[:lower:]]" "ß") 0))
+ (should (equal (string-match "[[:upper:]]" "ß") 0))
+ (should (equal (string-match "[[:alpha:]]" "ẞ") 0))
+ (should (equal (string-match "[[:lower:]]" "ẞ") 0))
+ (should (equal (string-match "[[:upper:]]" "ẞ") 0))))
+
;;; regex-emacs-tests.el ends here