diff options
297 files changed, 3209 insertions, 1567 deletions
diff --git a/.gitignore b/.gitignore index 3ef36b4310d..638d5415427 100644 --- a/.gitignore +++ b/.gitignore @@ -153,7 +153,7 @@ test/manual/etags/regexfile test/manual/etags/ETAGS test/manual/etags/CTAGS test/manual/indent/*.new -test/data/mml-sec/random_seed +test/lisp/gnus/mml-sec-resources/random_seed # ctags, etags. TAGS diff --git a/ChangeLog.2 b/ChangeLog.2 index ebaf3846dca..5e9b8b901e0 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -9269,7 +9269,7 @@ This is related to the autogen.sh changes made by Paul Eggert in commit d766ca8f (2016-02-01) and commit cedd7cad (2016-02-01), and to - my edits today to http://www.emacswiki.org/emacs/GitForEmacsDevs and + my edits today to https://www.emacswiki.org/emacs/GitForEmacsDevs and to emacswiki.org/emacs/GitQuickStartForEmacsDevs. See also the thread "Recommend these .gitconfig settings for git integrity." at https://lists.gnu.org/r/emacs-devel/2016-01/threads.html#01802. @@ -13444,7 +13444,7 @@ (gdb-send): Recognize various ways of exiting from Python and Guile interpreters and returning to GDB. For details, see https://lists.gnu.org/r/emacs-devel/2015-12/msg00693.html - and http://stackoverflow.com/questions/31514741. + and https://stackoverflow.com/questions/31514741. 2015-12-16 Paul Eggert <eggert@cs.ucla.edu> @@ -23731,7 +23731,7 @@ * lisp/progmodes/etags.el (etags-tags-completion-table): Allow even one non-regular character before the implicit tag name. - Reported at http://emacs.stackexchange.com/questions/15269/. + Reported at https://emacs.stackexchange.com/questions/15269/. 2015-09-06 Thomas Fitzsimmons <fitzsim@fitzsim.org> diff --git a/ChangeLog.3 b/ChangeLog.3 index ec2d3f8d462..0f363100794 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -44031,8 +44031,8 @@ * src/marker.c (buf_bytepos_to_charpos): Remove the assertion regarding bytepos always at the head byte of a multibyte sequence. For the reasons, see - http://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00100.html - http://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00102.html + https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00100.html + https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00102.html 2019-03-05 Wilson Snyder <wsnyder@wsnyder.org> @@ -45541,7 +45541,7 @@ * lisp/startup.el (command-line): Pass 'early-init.el', with an explicit .el extension, to load-user-init-file. Reported by Radon Rosborough <radon.neon@gmail.com> in - http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00314.html. + https://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00314.html. 2019-02-15 Stefan Monnier <monnier@iro.umontreal.ca> @@ -50624,7 +50624,7 @@ the correct directory in emacs_wd, which is now initialized way earlier in the startup process, when init_environment was not yet called. For details, see the problems reported in - http://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00068.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00068.html. Reported by Angelo Graziosi <angelo.g0@libero.it>. 2018-12-06 Juri Linkov <juri@linkov.net> @@ -52313,7 +52313,7 @@ * lib-src/emacsclient.c (set_local_socket): Don't ignore socket ownership when run by root. - Ref: http://lists.gnu.org/r/emacs-devel/2018-11/msg00019.html + Ref: https://lists.gnu.org/r/emacs-devel/2018-11/msg00019.html 2018-11-13 Eli Zaretskii <eliz@gnu.org> @@ -57139,7 +57139,7 @@ alias for thai-iso8859-11. Instead, reinstate the original definition of tis620-2533, but without eight-bit-control in the :superset attribute. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00117.html + https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00117.html and the surrounding discussions. * lisp/international/fontset.el (font-encoding-alist) (font-encoding-charset-alist): Reinstate tis620-2533 charset. @@ -60017,7 +60017,7 @@ * src/w32proc.c (syms_of_ntproc) <w32-pipe-read-delay>: Set to zero. For the details, see this discussion: - http://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00711.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00711.html. * src/w32.c (_sys_read_ahead): Update the commentary for w32-pipe-read-delay usage. @@ -62471,7 +62471,7 @@ * lisp/subr.el (string-to-unibyte): No longer obsolete. See the emacs-devel discussion around this message: - http://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00656.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00656.html. * etc/NEWS: Announce the change. @@ -63512,7 +63512,7 @@ * lisp/international/fontset.el (font-encoding-alist): Fix the GB18030 entry to encode characters correctly when passing them to the xfont back-end. (Bug#31315) See also - http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. + https://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. 2018-05-04 Noam Postavsky <npostavs@gmail.com> @@ -65267,7 +65267,7 @@ (eww-display-html): ... and don't get it here, because it's gone by now. - Test URL: http://www.gnu.org/s/hyperbole/#summary + Test URL: https://www.gnu.org/s/hyperbole/#summary 2018-04-13 Robert Pluim <rpluim@gmail.com> @@ -70827,7 +70827,7 @@ TO_CHARPOS, but didn't yet produce glyphs for that buffer position, because the last call to PRODUCE_GLYPHS at this position was for an object other than the buffer. For further details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. 2018-01-19 Reuben Thomas <rrt@sc3d.org> @@ -80561,7 +80561,7 @@ * configure.ac: Add -Wabi to the list of disabled warning options. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00123.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00123.html. 2018-08-10 Filipp Gunbin <fgunbin@fastmail.fm> @@ -80935,7 +80935,7 @@ * lisp/emacs-lisp/rx.el (rx): Clarify and improve the doc string. For the details, see the discussion starting at - http://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00399.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00399.html. 2018-07-19 Eli Zaretskii <eliz@gnu.org> @@ -81072,7 +81072,7 @@ Improve documentation of Flyspell For the background, see - http://lists.gnu.org/archive/html/help-gnu-emacs/2018-07/msg00099.html. + https://lists.gnu.org/archive/html/help-gnu-emacs/2018-07/msg00099.html. * doc/emacs/fixit.texi (Spelling): Add a couple of caveats. * lisp/textmodes/flyspell.el: Update commentary. @@ -81781,7 +81781,7 @@ * lisp/info.el: Explain in commentary why some commands start with "info-" and others with "Info-". See also - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00482.html. + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00482.html. 2018-06-13 Michael Albinus <michael.albinus@gmx.de> @@ -82336,7 +82336,7 @@ * lisp/international/fontset.el (font-encoding-alist): Fix the GB18030 entry to encode characters correctly when passing them to the xfont back-end. (Bug#31315) See also - http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. + https://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. (cherry picked from commit bbe2cadc544e63e9378350621887f8fb9bbcc236) @@ -82460,7 +82460,7 @@ TO_CHARPOS, but didn't yet produce glyphs for that buffer position, because the last call to PRODUCE_GLYPHS at this position was for an object other than the buffer. For further details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. (cherry picked from commit c0154ac7c3423f68d8f3a2e85a756c9759219039) @@ -83153,7 +83153,7 @@ (Note for Novices): * doc/lispref/tips.texi (Key Binding Conventions): Fix use of @key. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00390.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00390.html. 2018-04-19 Eli Zaretskii <eliz@gnu.org> @@ -83239,7 +83239,7 @@ * src/process.c (Fmake_pipe_process): Set up the decoding and encoding buffers. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00295.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00295.html. 2018-04-13 Robert Pluim <rpluim@gmail.com> @@ -84015,7 +84015,7 @@ * doc/lispref/variables.texi (Local Variables): Make more clear that local bindings of 'let' are in effect only within the body. Suggested by Marcin Borkowski <mbork@mbork.pl>, see - http://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00217.html + https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00217.html for the details. * doc/emacs/programs.texi (Matching): Fix a typo. Reported by @@ -85790,7 +85790,7 @@ * doc/emacs/text.texi (Words): Improve wording. Reported by Marcin Borkowski <mbork@mbork.pl> in - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00784.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00784.html. 2018-01-28 Martin Rudalics <rudalics@gmx.at> @@ -86006,7 +86006,7 @@ This is part two of a two part fix for the GTK scaling problems. See the thread starting at - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html for an explanation of why it has been added to Emacs 26. * src/gtkutil.c (xg_set_geometry): Scale down the coordinates that we @@ -86019,7 +86019,7 @@ This is part one of a two part fix for the GTK scaling problems. See the thread starting at - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html for an explanation of why it has been added to Emacs 26. * src/xfns.c (Fx_display_monitor_attributes_list): Take scaling factor @@ -86163,7 +86163,7 @@ being compiled is specified by an absolute file name. This avoids problems with ACL copying from temporary-file-directory on FreeBSD. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00513.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00513.html. 2018-01-19 Eli Zaretskii <eliz@gnu.org> @@ -86356,7 +86356,7 @@ * doc/lispref/variables.texi (File Local Variables): Mention the autoload cookie as a means of defining safe values for variables. - See http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00261.html + See https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00261.html for the details. * doc/lispref/compile.texi (Compiler Errors): Document 'byte-compile-error-on-warn'. @@ -86750,7 +86750,7 @@ scroll-margin when scrolling down, i.e. moving window-start towards the beginning of the buffer. Reported by zhang cc <ccsmile2008@outlook.com> in - http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00894.html. + https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00894.html. 2017-12-29 Eli Zaretskii <eliz@gnu.org> @@ -86991,7 +86991,7 @@ Clarify what selecting a window means for keyboard input, and that input focus may need to be considered when selecting windows on other frames. See - http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00372.html + https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00372.html for more details. 2017-12-22 Eli Zaretskii <eliz@gnu.org> @@ -87530,7 +87530,7 @@ * lisp/progmodes/prog-mode.el (prog-indentation-context): Un-document all elements but the first. (prog-widen): Remove. - (http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00321.html) + (https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00321.html) * doc/lispref/text.texi (Mode-Specific Indent): Update. @@ -87675,7 +87675,7 @@ Import the latest IVD_Sequences.txt * admin/unidata/IVD_Sequences.txt: New version from - http://www.unicode.org/ivd/, the 2017-12-12 version of the Unicode + https://www.unicode.org/ivd/, the 2017-12-12 version of the Unicode Ideographic Variation Database. * src/macuvs.h: Regenerated. @@ -87989,7 +87989,7 @@ * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Pass basename of target-file to make-temp-file, in case target-file includes a leading directory that might not exist under TMPDIR. See - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00680.html + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00680.html for the details. 2017-12-02 Michael Albinus <michael.albinus@gmx.de> @@ -88670,7 +88670,7 @@ * lisp/calc/calc-aent.el (math-read-token): Make sure the match against "0[xX][0-9a-fA-F]+" is found at math-exp-pos. See - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00174.html + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00174.html for the details. 2017-11-18 Eli Zaretskii <eliz@gnu.org> @@ -88984,7 +88984,7 @@ * lisp/files.el (find-file, find-file-other-window) (find-file-other-frame): Mention file-name-at-point-functions in the doc string. Reported by Florian Weimer <fw@deneb.enyo.de> in - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00224.html. + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00224.html. * doc/emacs/mini.texi (Minibuffer History): Document file-name-at-point-functions and its effect on M-n when typing @@ -97350,7 +97350,7 @@ Improve make-temp-file performance on local files For the motivation behind this patch, please see Bug#28023 and: - http://emacshorrors.com/posts/make-temp-name.html + https://emacshorrors.com/posts/make-temp-name.html Although, given the recent changes to Tramp, the related security problem in make-temp-file is already fixed, make-temp-file still has several unnecessary system calls. In the typical case on GNU/Linux, @@ -104823,7 +104823,7 @@ Remove s_client usage from tls.el * lisp/net/tls.el (tls-program, tls-checktrust): Remove s_client. - Ref http://bugs.debian.org/766397 + Ref https://bugs.debian.org/766397 https://lists.gnu.org/r/emacs-devel/2014-10/msg00803.html @@ -107262,7 +107262,7 @@ Remove s_client usage from tls.el * lisp/net/tls.el (tls-program, tls-checktrust): Remove s_client. - Ref http://bugs.debian.org/766397 + Ref https://bugs.debian.org/766397 https://lists.gnu.org/r/emacs-devel/2014-10/msg00803.html 2017-04-25 Glenn Morris <rgm@gnu.org> @@ -107708,7 +107708,7 @@ * lisp/emacs-lisp/ert.el (ert--expand-should-1): Avoid errors related to undefined byte-compile-macro-environment. Somehow masked until very recently because loading seq (eg) - loads bytecomp. http://hydra.nixos.org/build/51730765 + loads bytecomp. https://hydra.nixos.org/build/51730765 2017-04-18 Eli Zaretskii <eliz@gnu.org> @@ -108380,7 +108380,7 @@ * test/lisp/emacs-lisp/package-tests.el (with-package-test): Also bind package-gnupghome-dir, see eg - http://hydra.nixos.org/build/51462182 . + https://hydra.nixos.org/build/51462182 . 2017-04-11 Martin Rudalics <rudalics@gmx.at> @@ -113197,7 +113197,7 @@ The [5ec3a584: Generate upcase and downcase tables from Unicode data] commit broke bootstrap from a truly clean tree (e.g. a fresh clone or one created with ‘make extraclean’), see - <http://hydra.nixos.org/build/48774928>. + <https://hydra.nixos.org/build/48774928>. The failure was caused by characters.el trying to read Unicode property tables which aren’t available so early in the build process. @@ -122075,7 +122075,7 @@ Support zstd compressed files * lisp/jka-cmpr-hook.el (jka-compr-compression-info-list): Add - zstd compression info: <http://facebook.github.io/zstd/>. + zstd compression info: <https://facebook.github.io/zstd/>. (jka-compr-mode-alist-additions): Handle .tzst suffix for zstd compressed tar archives. (Bug#24853) @@ -147,7 +147,9 @@ lisp/ps-mule.el defines the *.bdf font files required for printing each character set. The intlfonts distribution contains its own installation instructions, -in the intlfonts/README file. +in the intlfonts/README file. See also the Emacs Frequently Asked +Questions info pages "(efaq) How to add fonts" for installation +instructions. * Image support libraries diff --git a/admin/ChangeLog.1 b/admin/ChangeLog.1 index 7a576a03123..64c65bdd12c 100644 --- a/admin/ChangeLog.1 +++ b/admin/ChangeLog.1 @@ -1629,10 +1629,10 @@ 2010-09-05 Juanma Barranquero <lekktu@gmail.com> * unidata/BidiMirroring.txt: Update from - http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d2.txt + https://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d2.txt * unidata/UnicodeData.txt: Update from - http://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d7.txt + https://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d7.txt 2010-08-09 Andreas Schwab <schwab@linux-m68k.org> @@ -1668,7 +1668,7 @@ * unidata/bidimirror.awk: New file. * unidata/BidiMirroring.txt: New file from - http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d1.txt. + https://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d1.txt. * unidata/Makefile.in (../../src/bidimirror.h): New target. (all): Depend on ../../src/biditype.h and ../../src/bidimirror.h. @@ -1685,7 +1685,7 @@ 2010-06-09 Juanma Barranquero <lekktu@gmail.com> * unidata/UnicodeData.txt: Update from - http://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d5.txt + https://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d5.txt 2010-05-27 Glenn Morris <rgm@gnu.org> @@ -2031,7 +2031,7 @@ * unidata/unidata-gen.el: New file. * unidata/UnicodeData.txt: New file. Copied from - http://www.unicode.org on 2006-05-23. + https://www.unicode.org on 2006-05-23. * unidata/.cvsignore: New file. diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README index fe1d07f4f98..c3205672d19 100644 --- a/admin/charsets/mapfiles/README +++ b/admin/charsets/mapfiles/README @@ -20,7 +20,7 @@ Available at: * PTCP154 Available at: - <http://www.iana.org/assignments/charset-reg/PTCP154> + <https://www.iana.org/assignments/charset-reg/PTCP154> * Uni2JIS @@ -50,8 +50,8 @@ Available at: * CP720.map and CP858.map Created manually by looking at these pages: - <http://en.wikipedia.org/wiki/Code_page_720>. - <http://en.wikipedia.org/wiki/Code_page_859>. + <https://en.wikipedia.org/wiki/Code_page_720>. + <https://en.wikipedia.org/wiki/Code_page_859>. The text in that page is under the terms of the GNU Free Documentation License. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 6f1bc802b85..7dadb0966f2 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -244,6 +244,7 @@ point vertically in the window, but there are several ways to alter this behavior. @vindex scroll-conservatively +@vindex scroll-minibuffer-conservatively If you set @code{scroll-conservatively} to a small number @var{n}, then moving point just a little off the screen (no more than @var{n} lines) causes Emacs to scroll just enough to bring point back on @@ -255,6 +256,9 @@ moves; Emacs always scrolls text just enough to bring point into view, either at the top or bottom of the window depending on the scroll direction. By default, @code{scroll-conservatively} is@tie{}0, which means to always center point in the window. +This said, in minibuffer windows, scrolling is always conservative by +default because @code{scroll-minibuffer-conservatively} is non-nil, +which takes precedence over @code{scroll-conservatively}. @vindex scroll-step Another way to control automatic scrolling is to customize the @@ -1173,31 +1177,34 @@ right-to-left paragraphs. @cindex mode, display-fill-column-indicator @findex display-fill-column-indicator-mode @findex global-display-fill-column-indicator-mode - Emacs can add an indicator to display a fill column position. The -fill column indicator is a useful functionality especially in -@code{prog-mode} to indicate the position of a specific column. + Emacs can display an indication of the @code{fill-column} position +(@pxref{Fill Commands}). The fill-column indicator is a useful +functionality especially in @code{prog-mode} and its descendants +(@pxref{Major Modes}) to indicate the position of a specific column +that has some special meaning for formatting the source code of a +program. + + To activate the fill-column indication display, use the minor modes +@w{@kbd{M-x display-fill-column-indicator-mode}} and +@w{@kbd{M-x global-display-fill-column-indicator-mode}}, which enable +the indicator locally or globally, respectively. - You can set the buffer-local variables +Alternatively, you can set the two buffer-local variables @code{display-fill-column-indicator} and @code{display-fill-column-indicator-character} to activate the -indicator and control how it looks, respectively. +indicator and control the character used for the indication. Note +that both variables must be non-@code{nil} for the indication to be +displayed. (Turning on the minor mode sets both these variables.) -Alternatively you can type @w{@kbd{M-x display-fill-column-indicator-mode}} -or @w{@kbd{M-x global-display-fill-column-indicator-mode}} which -enables the indicator locally or globally, respectively, and also -chooses the character to use if none is already set. It is possible -to use the first one to activate the indicator in a hook and the -second one to enable it globally. - -There are 2 buffer local variables and 1 face to customize this mode: +There are 2 buffer local variables and a face to customize this mode: @table @code @item display-fill-column-indicator-column @vindex display-fill-column-indicator-column Specifies the column number where the indicator should be set. It can -take positive numerical values for the column or the special value -@code{t} which means that the variable @code{fill-column} will be -used. +take positive numerical values for the column, or the special value +@code{t}, which means that the value of the variable +@code{fill-column} will be used. Any other value disables the indicator. The default value is @code{t}. @@ -1205,18 +1212,18 @@ Any other value disables the indicator. The default value is @code{t}. @vindex display-fill-column-indicator-character Specifies the character used for the indicator. This character can be any valid character including Unicode ones if the font supports them. - -When the mode is enabled through the functions -@code{display-fill-column-indicator-mode} or -@code{global-display-fill-column-indicator-mode}, the initialization -functions check if this variable is non-@code{nil}, otherwise the -initialization tries to set it to @code{U+2502} or @samp{|}. +The value @code{nil} disables the indicator. When the mode is enabled +through the functions @code{display-fill-column-indicator-mode} or +@code{global-display-fill-column-indicator-mode}, they will use the +character specified by this variable, if it is non-@code{nil}; +otherwise Emacs will use the character @samp{U+2502 VERTICAL LINE}, +falling back to @samp{|} if @code{U+2502} cannot be displayed. @item fill-column-indicator @vindex fill-column-indicator Specifies the face used to display the indicator. It inherits its -default values from the face @code{shadow} but without background -color. To change the indicator color you need only set the foreground +default values from the face @code{shadow}, but without background +color. To change the indicator color, you need only set the foreground color of this face. @end table @@ -1605,7 +1612,8 @@ can cause problems if they are entered into a buffer without your realization, e.g., by yanking; for instance, source code compilers typically do not treat non-@acronym{ASCII} spaces as whitespace characters. To deal with this problem, Emacs displays such characters -specially: it displays @code{U+00A0} (no-break space) with the +specially: it displays @code{U+00A0} (no-break space) and other +characters from the Unicode horizontal space class with the @code{nobreak-space} face, and it displays @code{U+00AD} (soft hyphen), @code{U+2010} (hyphen), and @code{U+2011} (non-breaking hyphen) with the @code{nobreak-hyphen} face. To disable this, change diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 51e8bd1382f..eb4353b6784 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1629,6 +1629,10 @@ Convert the entire buffer to unified diff format unified format to context format. When the mark is active, convert only the hunks within the region. +@item C-c C-l +@findex diff-refresh-hunk +Re-generate the current hunk (@code{diff-refresh-hunk}). + @item C-c C-w @findex diff-ignore-whitespace-hunk Re-generate the current hunk, disregarding changes in whitespace diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 8959175def8..ebfda01671e 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2508,16 +2508,22 @@ button-down events entirely. It also reshuffles focus events and miscellaneous window events so that they never appear in a key sequence with any other events. -@cindex @code{tab-line} prefix key -@cindex @code{header-line} prefix key -@cindex @code{mode-line} prefix key -@cindex @code{vertical-line} prefix key -@cindex @code{horizontal-scroll-bar} prefix key -@cindex @code{vertical-scroll-bar} prefix key -@cindex @code{menu-bar} prefix key -@cindex @code{tab-bar} prefix key -@cindex mouse events, in special parts of frame -When mouse events occur in special parts of a window, such as a mode +@cindex @code{tab-line}, prefix key +@cindex @code{header-line}, prefix key +@cindex @code{mode-line}, prefix key +@cindex @code{vertical-line}, prefix key +@cindex @code{horizontal-scroll-bar}, prefix key +@cindex @code{vertical-scroll-bar}, prefix key +@cindex @code{menu-bar}, prefix key +@cindex @code{tab-bar}, prefix key +@cindex @code{left-margin}, prefix key +@cindex @code{right-margin}, prefix key +@cindex @code{left-fringe}, prefix key +@cindex @code{right-fringe}, prefix key +@cindex @code{right-divider}, prefix key +@cindex @code{bottom-divider}, prefix key +@cindex mouse events, in special parts of window or frame +When mouse events occur in special parts of a window or frame, such as a mode line or a scroll bar, the event type shows nothing special---it is the same symbol that would normally represent that combination of mouse button and modifier keys. The information about the window part is kept @@ -2525,9 +2531,11 @@ elsewhere in the event---in the coordinates. But @code{read-key-sequence} translates this information into imaginary prefix keys, all of which are symbols: @code{tab-line}, @code{header-line}, @code{horizontal-scroll-bar}, @code{menu-bar}, @code{tab-bar}, @code{mode-line}, -@code{vertical-line}, and @code{vertical-scroll-bar}. You can define -meanings for mouse clicks in special window parts by defining key -sequences using these imaginary prefix keys. +@code{vertical-line}, @code{vertical-scroll-bar}, @code{left-margin}, +@code{right-margin}, @code{left-fringe}, @code{right-fringe}, +@code{right-divider}, and @code{bottom-divider}. You can define meanings for +mouse clicks in special window parts by defining key sequences using these +imaginary prefix keys. For example, if you call @code{read-key-sequence} and then click the mouse on the window's mode line, you get two events, like this: diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index c3043423039..6fc8587fe52 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -8037,7 +8037,7 @@ positions do not increase monotonically with string or buffer position. In performing this @dfn{bidirectional reordering}, Emacs follows the Unicode Bidirectional Algorithm (a.k.a.@: @acronym{UBA}), which is described in Annex #9 of the Unicode standard -(@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full +(@url{https://www.unicode.org/reports/tr9/}). Emacs provides a ``Full Bidirectionality'' class implementation of the @acronym{UBA}, consistent with the requirements of the Unicode Standard v9.0. Note, however, that the way Emacs displays continuation lines when text diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 22d32c00d9b..e3d0fdeb277 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3526,6 +3526,13 @@ This abnormal hook exists for the benefit of packages like @file{xt-mouse.el} that need to do mouse handling at the Lisp level. @end defvar +@defvar tty-menu-calls-mouse-position-function +If non-@code{nil}, TTY menus will call @code{mouse-position-function} +as described above. This exists for cases where +@code{mouse-position-function} is not safe to be called by the TTY +menus, such as if it could trigger redisplay. +@end defvar + @defun set-mouse-position frame x y This function @dfn{warps the mouse} to position @var{x}, @var{y} in frame @var{frame}. The arguments @var{x} and @var{y} are integers, diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index d00acd0ded3..e5a0233b3c7 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2501,8 +2501,10 @@ frame is the buffer whose contents will be shown the next time that window is redisplayed. The function is expected to fit the frame to the buffer in some appropriate way. -Any other non-@code{nil} value means to resize minibuffer-only frames -by calling @code{fit-frame-to-buffer} (@pxref{Resizing Windows}). +Any other non-@code{nil} value means to resize minibuffer-only frames by +calling @code{fit-mini-frame-to-buffer}, a function that behaves like +@code{fit-frame-to-buffer} (@pxref{Resizing Windows}) but does not strip +leading or trailing empty lines from the buffer text. @end defopt diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 022eda0bec8..98aa94e90d4 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1806,10 +1806,11 @@ don't need any. @defmac define-globalized-minor-mode global-mode mode turn-on keyword-args@dots{} body@dots{} This defines a global toggle named @var{global-mode} whose meaning is -to enable or disable the buffer-local minor mode @var{mode} in all -buffers. It also executes the @var{body} forms. To turn on the minor -mode in a buffer, it uses the function @var{turn-on}; to turn off the -minor mode, it calls @var{mode} with @minus{}1 as argument. +to enable or disable the buffer-local minor mode @var{mode} in all (or +some; see below) buffers. It also executes the @var{body} forms. To +turn on the minor mode in a buffer, it uses the function +@var{turn-on}; to turn off the minor mode, it calls @var{mode} with +@minus{}1 as argument. Globally enabling the mode also affects buffers subsequently created by visiting files, and buffers that use a major mode other than @@ -1830,6 +1831,38 @@ also define a non-globalized version, so that people can use (or disable) it in individual buffers. This also allows them to disable a globally enabled minor mode in a specific major mode, by using that mode's hook. + +If given a @code{:predicate} keyword, a user option called the same as +the global mode variable, but with @code{-modes} instead of +@code{-mode} at the end will be created. The variable is used as a +predicate that specifies which major modes the minor mode should be +activated in. Valid values include @code{t} (use in all major modes, +@code{nil} (use in no major modes), or a list of mode names (or +@code{(not mode-name ...)}) elements (as well as @code{t} and +@code{nil}). + +@example +(c-mode (not mail-mode message-mode) text-mode) +@end example + +This means ``use in modes derived from @code{c-mode}, and not in +modes derived from @code{message-mode} or @code{mail-mode}, but do use +in modes derived from @code{text-mode}, and otherwise no other +modes''. + +@example +((not c-mode) t) +@end example + +This means ``don't use modes derived from @code{c-mode}, but use +everywhere else''. + +@example +(text-mode) +@end example + +This means ``use in modes derived from @code{text-mode}, but nowhere +else''. (There's an implicit @code{nil} element at the end.) @end defmac diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 504f0dfb23e..2c30d8ad892 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1901,7 +1901,10 @@ The integer number of hours. The integer number of minutes. @item %s @itemx %S -The integer number of seconds. +The number of seconds. If the optional @samp{,} parameter is used, +it's a floating point number, and the number after the @samp{,} +specifies how many decimals to be used. @samp{%,2s} means ``use two +decimals''. @item %z Non-printing control flag. When it is used, other specifiers must be given in the order of decreasing size, i.e., years before days, hours diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 559b2b1c973..550e7feee2e 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -2566,7 +2566,7 @@ the beginning of the line (if @var{nochange-regexp} is non-@code{nil}). This section describes two commands that indent the current line based on the contents of previous lines. -@deffn Command indent-relative &optional unindented-ok +@deffn Command indent-relative &optional first-only unindented-ok This command inserts whitespace at point, extending to the same column as the next @dfn{indent point} of the previous nonblank line. An indent point is a non-whitespace character following whitespace. The @@ -2582,6 +2582,9 @@ nothing (if @var{unindented-ok} is non-@code{nil}) or calls of the last column of a short line of text, this command ordinarily moves point to the next tab stop by inserting whitespace. +If @var{first-only} is non-@code{nil}, only the first indent point is +considered. + The return value of @code{indent-relative} is unpredictable. In the following example, point is at the beginning of the second diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index aaef85897e8..32836639a01 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -95,6 +95,11 @@ If one prefix is insufficient, your package can use two or three alternative common prefixes, so long as they make sense. @item +We recommend enabling @code{lexical-binding} in new code, and +converting existing Emacs Lisp code to enable @code{lexical-binding} +if it doesn't already. @xref{Using Lexical Binding}. + +@item Put a call to @code{provide} at the end of each separate Lisp file. @xref{Named Features}. @@ -990,7 +995,7 @@ explains these conventions, starting with an example: @smallexample @group -;;; foo.el --- Support for the Foo programming language +;;; foo.el --- Support for the Foo programming language -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2020 Your Name @end group @@ -1013,14 +1018,14 @@ explains these conventions, starting with an example: The very first line should have this format: @example -;;; @var{filename} --- @var{description} +;;; @var{filename} --- @var{description} -*- lexical-binding: t; -*- @end example @noindent -The description should be contained in one line. If the file -needs a @samp{-*-} specification, put it after @var{description}. -If this would make the first line too long, use a Local Variables -section at the end of the file. +The description should be contained in one line. If the file needs to +set more variables in the @samp{-*-} specification, add it after +@code{lexical-binding}. If this would make the first line too long, use +a Local Variables section at the end of the file. The copyright notice usually lists your name (if you wrote the file). If you have an employer who claims copyright on your work, you diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 394fb96acbe..095ea9dce24 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1317,9 +1317,9 @@ a Unix shell and @command{make} are used for byte-compilation: @example $ rm *.elc # force recompilation $ EMACS_GENERATE_DYNVARS=1 make # generate .dynvars -$ cat *.dynvars > ~/my.dynvars # combine .dynvars +$ cat *.dynvars > ~/my-dynvars # combine .dynvars $ rm *.elc # force recompilation -$ EMACS_DYNVARS_FILE=~/my.dynvars make # perform checks +$ EMACS_DYNVARS_FILE=~/my-dynvars make # perform checks @end example @node Buffer-Local Variables diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index bbfc86b111e..c875d58ef16 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -1188,9 +1188,9 @@ MS Windows, but this has still been insufficient to keep up with changes in printing technology from text and postscript based printers connected via ports that can be accessed directly, to graphical printers that are only accessible via USB@. For details, see -@uref{http://www.emacswiki.org/emacs/PrintingFromEmacs, Emacs -Wiki}, @uref{http://www.emacswiki.org/emacs/PrintWithWebBrowser}, and -@uref{http://www.emacswiki.org/emacs/PrintFromWindowsExplorer}. +@uref{https://www.emacswiki.org/emacs/PrintingFromEmacs, Emacs +Wiki}, @uref{https://www.emacswiki.org/emacs/PrintWithWebBrowser}, and +@uref{https://www.emacswiki.org/emacs/PrintFromWindowsExplorer}. @c ------------------------------------------------------------ @node Sub-processes @@ -1414,7 +1414,7 @@ continue to use bash as your subshell: @cindex cygwin mount points, using within Emacs The package -@uref{http://www.emacswiki.org/emacs/cygwin-mount.el, +@uref{https://www.emacswiki.org/emacs/cygwin-mount.el, cygwin-mount.el} teaches Emacs about Cygwin mount points. @node Dired ls @@ -1793,7 +1793,7 @@ do not need to add its installation directory to the @env{PATH}. @cindex Emacs distribution, checking digital signatures GNU Privacy Guard is a Free replacement for PGP, with Windows binaries -available. See @uref{http://www.gnupg.org/}. +available. See @uref{https://www.gnupg.org/}. @node Mouse wheel @section Why doesn't my wheel mouse work in Emacs? @@ -2131,7 +2131,7 @@ suggestions} for improving the interaction of perldb and Emacs. @cindex subprocesses, cygwin tools @vindex exec-path -@uref{http://www.cygwin.com/}. +@uref{https://www.cygwin.com/}. Cygwin is a popular complete POSIX emulation environment for Windows. Most of its tools can be used with Emacs, and it covers a wide range @@ -2281,7 +2281,7 @@ and you can view the FAQ by typing @kbd{C-h C-f}. Other resources include: @itemize @item @uref{https://www.gnu.org/software/emacs/, The Emacs homepage} @item @uref{https://www.gnu.org/software/emacs/manual/, Other Emacs manuals} -@item @uref{http://www.emacswiki.org/, Emacs Wiki} +@item @uref{https://www.emacswiki.org/, Emacs Wiki} @end itemize @node Mailing lists diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index e1b099edaab..1bc9d41f9bb 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -400,7 +400,7 @@ archive can be browsed over the web at @uref{https://lists.gnu.org/r/, the GNU mail archive}. Web-based Usenet search services, such as -@uref{http://groups.google.com/groups/dir?q=gnu&, Google}, also +@uref{https://groups.google.com/groups/dir?q=gnu&, Google}, also archive the @code{gnu.*} groups. @node Reporting bugs @@ -865,7 +865,7 @@ Bulletin}, are at @uref{https://www.gnu.org/bulletins/bulletins.html} and -@uref{http://www.cs.pdx.edu/~trent/gnu/gnu.html} +@uref{https://www.cs.pdx.edu/~trent/gnu/gnu.html} @node Help installing Emacs @section Where can I get help in installing Emacs? @@ -3613,7 +3613,7 @@ For a list of other MS-DOS implementations of Emacs (and Emacs look-alikes), consult the list of ``Emacs implementations and literature,'' available at -@uref{http://www.finseth.com/emacs.html} +@uref{https://www.finseth.com/emacs.html} Note that while many of these programs look similar to Emacs, they often lack certain features, such as the Emacs Lisp extension language. diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index 5cb6b19181c..538c088282b 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -247,15 +247,15 @@ Here are a number of screenshots showing IDLWAVE in action: @itemize @bullet @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_nav.gif,An IDLWAVE buffer} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_nav.gif,An IDLWAVE buffer} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_keys.gif,A keyword being completed} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_keys.gif,A keyword being completed} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_help.gif,Online help text.} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_help.gif,Online help text.} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_ri.gif,Routine information displayed} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_ri.gif,Routine information displayed} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_bp.gif,Debugging code +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_bp.gif,Debugging code stopped at a breakpoint} @end itemize @end ifnottex diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 495d562f50b..b7e05feb0f1 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -3753,7 +3753,7 @@ A link should be enclosed in double brackets and may contain descriptive text to be displayed instead of the URL (see @ref{Link Format}), for example: @example -[[http://www.gnu.org/software/emacs/][GNU Emacs]] +[[https://www.gnu.org/software/emacs/][GNU Emacs]] @end example @@ -22361,7 +22361,7 @@ Marco Wahl wrote @samp{ol-eww.el}. @display Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. -@uref{http://fsf.org/} +@uref{https://fsf.org/} Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -22786,7 +22786,7 @@ The Free Software Foundation may publish new, revised versions of the GNU Free Documentation License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. See -@uref{http://www.gnu.org/copyleft/}. +@uref{https://www.gnu.org/copyleft/}. Each version of the License is given a distinguishing version number. If the Document specifies that a particular numbered diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi index c3df33eb9aa..d1951f581c9 100644 --- a/doc/misc/pcl-cvs.texi +++ b/doc/misc/pcl-cvs.texi @@ -1389,7 +1389,7 @@ bugs, please report them separately. If you have problems using PCL-CVS or other questions, send them to the @url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs, help-gnu-emacs mailing list}. This is a good place to get help, as is -the @url{http://lists.nongnu.org/mailman/listinfo/info-cvs, info-cvs list}. +the @url{https://lists.nongnu.org/mailman/listinfo/info-cvs, info-cvs list}. If you have ideas for improvements, or if you have written some extensions to this package, we would like to hear from you. We hope that diff --git a/doc/misc/pgg.texi b/doc/misc/pgg.texi index 5daa16fb27e..261897b735c 100644 --- a/doc/misc/pgg.texi +++ b/doc/misc/pgg.texi @@ -94,7 +94,7 @@ and that you are familiar with its basic functions. By default, PGG uses GnuPG@. If you are new to such a system, I recommend that you should look over the GNU Privacy Handbook (GPH) -which is available at @uref{http://www.gnupg.org/documentation/}. +which is available at @uref{https://www.gnupg.org/documentation/}. When using GnuPG, we recommend the use of the @code{gpg-agent} program, which is distributed with versions 2.0 and later of GnuPG@. diff --git a/etc/HELLO b/etc/HELLO index fcc907536e3..9ea7ebc2de3 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -40,6 +40,8 @@ Danish (dansk) Hej / Goddag / Halløj Dutch (Nederlands) Hallo / Dag Efik /ˈɛfɪk/ Mɔkɔm +Egyptian Hieroglyphs (𓂋𓏤𓈖𓆎𓅓𓏏𓊖) 𓅓𓊵𓏏𓊪, 𓇍𓇋𓂻𓍘𓇋 + Emacs emacs --no-splash -f view-hello-file Emoji 👋 @@ -59,7 +61,7 @@ Hindi (हिंदी) नमस्ते / नमस्कार । Inuktitut (ᐃᓄᒃᑎᑐᑦ) ᐊᐃ Italian (italiano) Ciao / Buon giorno -Javanese (ꦧꦱꦗꦮ) console.log("ꦱꦸꦒꦼꦁꦱꦶꦪꦁ"); +Javanese (ꦧꦱꦗꦮꦶ) console.log("ꦲꦭꦺꦴ"); Kannada (ಕನ್ನಡ) ನಮಸ್ಕಾರ Khmer (ភាសាខ្មែរ) ជំរាបសួរ Lao (ພາສາລາວ) ສະບາຍດີ / ຂໍໃຫ້ໂຊກດີ @@ -124,7 +126,7 @@ along with GNU Emacs. If not, see <<https://www.gnu.org/licenses/>. ;;; Local Variables: -;;; tab-width: 32 +;;; tab-width: 42 ;;; bidi-display-reordering: t ;;; coding: utf-8 ;;; inhibit-compacting-font-caches: t @@ -85,6 +85,9 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 +** Minibuffer scrolling is now conservative by default. +This is controlled by the new variable 'scroll-minibuffer-conservatively'. + +++ ** New system for displaying documentation for groups of function. This can either be used by saying 'M-x shortdoc-display-group' and @@ -163,6 +166,12 @@ your init file: (setq frame-title-format '(multiple-frames "%b" ("" invocation-name "@" system-name))) ++++ +** 'nobreak-char-display' now also affects all non-ASCII space characters. +Previously, this was limited only to NO-BREAK-SPACE and hyphen +characters. Now it also covers the rest of the non-ASCII Unicode +space characters. + * Editing Changes in Emacs 28.1 @@ -201,6 +210,7 @@ It moves point to the line relative to the accessible portion of the narrowed buffer. 'M-g M-g' in Info is rebound to this command. When 'widen-automatically' is non-nil, 'goto-line' widens the narrowed buffer to be able to move point to the inaccessible portion. +'goto-line-relative' is bound to 'C-x n g'. +++ ** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x' @@ -239,6 +249,13 @@ the buffer cycles the whole buffer between "only top-level headings", * Changes in Specialized Modes and Packages in Emacs 28.1 +** Python mode + +*** 'C-c C-r' can now be used on arbitrary regions. +The command previously extended the start of the region to the start +of the line, but will now actually send the marked region, as +documented. + ** Ruby mode *** 'ruby-use-smie' is declared obsolete. @@ -403,6 +420,14 @@ their 'default-directory' under VC. *** New command 'vc-dir-root' uses the root directory without asking. +--- +*** The responsible VC backend is now the most specific one. +'vc-responsible-backend' loops over the backends in +'vc-handled-backends' to determine which backend is responsible for a +specific (unregistered) file. Previously the first matching backend +was chosen, but now the one with the most specific path is chosen (in +case there's a directory handled by one backend inside another). + *** New commands 'vc-dir-mark-registered-files' (bound to '* r') and 'vc-dir-mark-unregistered-files'. @@ -575,6 +600,9 @@ skipped. ** Help +--- +*** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation. + +++ *** New command 'describe-keymap' describes keybindings in a keymap. @@ -636,7 +664,7 @@ definition. ** ElDoc +++ -*** New user option 'eldoc-display-truncation-message'. +*** New user option 'eldoc-echo-area-display-truncation-message'. If non-nil (the default), eldoc will display a message saying something like "(Documentation truncated. Use `M-x eldoc-doc-buffer' to see rest)" when a message has been truncated. If nil, truncated @@ -650,6 +678,13 @@ may arrange for it to be produced asynchronously. The results of all doc string functions are accessible to the user through the user option 'eldoc-documentation-strategy'. +*** New hook 'eldoc-display-functions'. +This hook is intended to be used for displaying doc string. The +functions receive the docstrings composed according to +`eldoc-documentation-strategy' and are tasked with displaying it to +the user. Examples of such functions would use the echo area, a +separate buffer or a tooltip. + +++ *** New user option 'eldoc-documentation-strategy'. The built-in choices available for this user option let users compose @@ -1176,8 +1211,31 @@ them, using the DEL and INS buttons respectively. This is useful in Custom buffers, for example, to change the order of the elements in a list. +** Diff + +--- +*** New 'diff-mode' font locking face 'diff-error'. +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. + + ** Miscellaneous ++++ +*** 'format-seconds' can now be used for sub-second times. +The new optional "," parameter has been added, and +(format-seconds "%mm %,1ss" 66.4) will now result in "1m 6.4s". + +--- +*** 'global-display-fill-column-indicator-mode' skips some buffers. +By default, turning on 'global-display-fill-column-indicator-mode' +doesn't turn on 'display-fill-column-indicator-mode' in special-mode +buffers. This can be controlled by customizing the variable +'global-display-fill-column-indicator-modes'. + --- *** New user option 'compilation-search-all-directories'. When doing parallel builds, directories and compilation errors may @@ -1264,10 +1322,6 @@ number [10]", or not have the default displayed at all, like "Enter a number". (This requires that all callers are altered to use 'format-prompt', though.) ---- -*** New 'diff-mode' font locking face 'diff-error'. -This face is used for error messages from diff. - +++ *** New global mode 'global-goto-address-mode'. This will enable 'goto-address-mode' in all buffers. @@ -1325,6 +1379,16 @@ to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list. 'gomoku-move-sw' and 'gomoku-move-ne' now work correctly, and horizontal movements now stop at the edge of the board. +** xterm-mouse mode + +--- +*** TTY menu navigation is now supported in 'xterm-mouse-mode'. +TTY menus support mouse navigation and selection when xterm-mouse-mode +is active. When run on a terminal, clicking on the menu bar with the +mouse now pops up a TTY menu by default instead of running the command +'tmm-menubar'. To restore the old behavior, set the variable +'tty-menu-open-use-tmm' to non-nil. + ** xwidget-webkit mode *** New xwidget commands. @@ -1600,6 +1664,11 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. * Lisp Changes in Emacs 28.1 +++ +** 'define-globalized-minor-mode' now takes a :predicate parameter. +This can be used to control which major modes the minor mode should be +used in. + ++++ ** 'truncate-string-ellipsis' now uses '…' by default. Modes that use 'truncate-string-to-width' with non-nil, non-string argument 'ellipsis', will now indicate truncation using '…' when @@ -1749,6 +1818,14 @@ This user option can be one of the predefined styles or a function to personalize the uniquified buffer name. +++ +** New variable 'tty-menu-calls-mouse-position-function'. +This controls whether 'mouse-position-function' is called by functions +that retrieve the mouse position when that happens during TTY menu +handling. Lisp programs that set 'mouse-position-function' should +also set this variable non-nil if they are compatible with the tty +menu handling. + ++++ ** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'. +++ @@ -1761,6 +1838,11 @@ file can affect code in another. For details, see the manual section --- ** 'unload-feature' now also tries to undo additions to buffer-local hooks. +--- +** Some functions are no longer considered safe by 'unsafep': +'replace-regexp-in-string', 'catch', 'throw', 'error', 'signal' +and 'play-sound-file'. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/etc/NEWS.27 b/etc/NEWS.27 index e7931330357..f0b5dd088af 100644 --- a/etc/NEWS.27 +++ b/etc/NEWS.27 @@ -21,11 +21,48 @@ Temporary note: When you add a new item, use the appropriate mark if you are sure it applies, and please also update docstrings as needed. + +* Installation Changes in Emacs 27.2 + + +* Startup Changes in Emacs 27.2 + + +* Changes in Emacs 27.2 + +This is a bug-fix release with no new features. + + +* Lisp Changes in Emacs 27.2 + +*** The behavior of the user option 'resize-mini-frames' has changed. +If set to non-nil, resize the mini frame using the new function +'fit-mini-frame-to-buffer' which won't skip leading or trailing empty +lines of the buffer. + + +* Editing Changes in Emacs 27.2 + + +* Changes in Specialized Modes and Packages in Emacs 27.2 + ** Tramp *** The user option 'tramp-completion-reread-directory-timeout' is made obsolete. +* New Modes and Packages in Emacs 27.2 + + +* Incompatible Lisp Changes in Emacs 27.2 + + +* Lisp Changes in Emacs 27.2 + + +* Changes in Emacs 27.2 on Non-Free Operating Systems + + * Installation Changes in Emacs 27.1 ** Emacs now uses GMP, the GNU Multiple Precision library. diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP index 77a1752a4a4..5ac3b6b1741 100644 --- a/etc/NEXTSTEP +++ b/etc/NEXTSTEP @@ -27,7 +27,7 @@ the absence of any other determinant, we are using the term created these APIs, and because all of the classes and functions still begin with the letters "NS". -(See http://en.wikipedia.org/wiki/Nextstep) +(See https://en.wikipedia.org/wiki/Nextstep) This Emacs port was first released in the early 1990's on the NeXT computer, and was successively updated to OpenStep, Rhapsody, Mac OS @@ -402,7 +402,7 @@ built-in. See the discussion of bug#39799 for more details about this task. Another relevant resource is the Unicode Technical Standard #51 -"Unicode Emoji" (http://www.unicode.org/reports/tr51/). +"Unicode Emoji" (https://www.unicode.org/reports/tr51/). ** Extend text-properties and overlays @@ -497,7 +497,7 @@ https://savannah.nongnu.org/projects/emacs-rtf/, which is still in very early stages. Another place to look is the Wikipedia article at -http://en.wikipedia.org/wiki/Rich_Text_Format. It currently points to +https://en.wikipedia.org/wiki/Rich_Text_Format. It currently points to the latest spec of RTF v1.9.1 at https://web.archive.org/web/20190708132914/http://www.kleinlercher.at/tools/Windows_Protocols/Word2007RTFSpec9.pdf diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index ac395f993c9..195d40d7af6 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -62,7 +62,7 @@ ;; org-mode, CUA-mode, apt-utils, bbdb, compilation buffers, changelog ;; mode, diff and ediff, eshell, and more. You need emacs-goodies ;; package on Debian to use this. See the wiki page at -;; http://www.emacswiki.org/cgi-bin/wiki?ColorTheme for details. The +;; https://www.emacswiki.org/cgi-bin/wiki?ColorTheme for details. The ;; project home page is at https://gna.org/projects/color-theme. ;;; Code: diff --git a/etc/tutorials/TUTORIAL.de b/etc/tutorials/TUTORIAL.de index f1461563c18..ae58fc9a44b 100644 --- a/etc/tutorials/TUTORIAL.de +++ b/etc/tutorials/TUTORIAL.de @@ -1280,7 +1280,7 @@ Funktion set-language-environment). Mittels C-x <Return> l latin-1 <Return> können Sie z.B. in einer laufenden Emacs-Sitzung auf Latin-1 -umzuschalten. Dadurch wird erreicht, dass Emacs beim Laden einer +umschalten. Dadurch wird erreicht, dass Emacs beim Laden einer Datei (und Speichern derselben) standardmäßig die Latin-1-Zeichenkodierung verwendet. Sie können an der Ziffer 1 unmittelbar vor dem Doppelpunkt links unten in der Statuszeile diff --git a/leim/MISC-DIC/CTLau-b5.html b/leim/MISC-DIC/CTLau-b5.html index e718edeb121..117a6ee374e 100644 --- a/leim/MISC-DIC/CTLau-b5.html +++ b/leim/MISC-DIC/CTLau-b5.html @@ -23,7 +23,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/>. +# along with this program. If not, see <https://www.gnu.org/licenses/>. # # # File Format: diff --git a/leim/MISC-DIC/CTLau.html b/leim/MISC-DIC/CTLau.html index 18a48c125d0..e7759117325 100644 --- a/leim/MISC-DIC/CTLau.html +++ b/leim/MISC-DIC/CTLau.html @@ -23,7 +23,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/>. +# along with this program. If not, see <https://www.gnu.org/licenses/>. # # # File Format: diff --git a/leim/MISC-DIC/pinyin.map b/leim/MISC-DIC/pinyin.map index 6c2117713b5..4809769d1ad 100644 --- a/leim/MISC-DIC/pinyin.map +++ b/leim/MISC-DIC/pinyin.map @@ -23,7 +23,7 @@ % details.
%
% You should have received a copy of the GNU General Public License along with
-% CCE. If not, see <http://www.gnu.org/licenses/>.
+% CCE. If not, see <https://www.gnu.org/licenses/>.
%
% End of header added for Emacs
a ߹
diff --git a/leim/MISC-DIC/ziranma.cin b/leim/MISC-DIC/ziranma.cin index 13a63fd7335..b61aea2b6f4 100644 --- a/leim/MISC-DIC/ziranma.cin +++ b/leim/MISC-DIC/ziranma.cin @@ -23,7 +23,7 @@ % details. % % You should have received a copy of the GNU General Public License along with -% CCE. If not, see <http://www.gnu.org/licenses/>. +% CCE. If not, see <https://www.gnu.org/licenses/>. % % End of header added for Emacs %ename ZiranMa diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11 index 52b85950be0..374a5668932 100644 --- a/lisp/ChangeLog.11 +++ b/lisp/ChangeLog.11 @@ -13392,7 +13392,7 @@ * progmodes/compile.el (compilation-error-regexp-alist): Add Java ANt error detection as described in document - http://ant.apache.org/faq.html + https://ant.apache.org/faq.html 2003-08-12 Juri Linkov <juri@jurta.org> (tiny change) diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index 6c093790d31..bb7389c5b71 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -379,7 +379,7 @@ 2013-02-28 Sam Steingold <sds@gnu.org> * vc/diff-mode.el (diff-hunk-file-names): Handle filenames with spaces. - See <http://stackoverflow.com/questions/14720205>. + See <https://stackoverflow.com/questions/14720205>. 2013-02-28 Thierry Volpiatto <thierry.volpiatto@gmail.com> @@ -1326,7 +1326,7 @@ * net/soap-client.el (soap-invoke): Encode the string for `url-request-data' as UTF-8. - Fixes <http://code.google.com/p/emacs-soap-client/issues/detail?id=16>. + Fixes <https://code.google.com/p/emacs-soap-client/issues/detail?id=16>. 2013-02-01 Glenn Morris <rgm@gnu.org> @@ -2462,7 +2462,7 @@ 2012-12-27 Sam Steingold <sds@gnu.org> * progmodes/cperl-mode.el (cperl-calculate-indent): Do not stagger - continuations, see <http://stackoverflow.com/questions/3582436>. + continuations, see <https://stackoverflow.com/questions/3582436>. 2012-12-27 Dmitry Gutov <dgutov@yandex.ru> @@ -11473,7 +11473,7 @@ (sh-set-shell): Use smie-setup if requested. * term.el (term-set-escape-char): Properly set term-escape-char. - See http://stackoverflow.com/questions/10524656. + See https://stackoverflow.com/questions/10524656. 2012-05-10 Chong Yidong <cyd@gnu.org> @@ -16476,7 +16476,7 @@ (python-pdbtrack-track-stack-file): Adjust to recognize ipdb as well as regular python pdb prompts. Adjustments shamelessly taken exactly as suggested in EmacsWiki page (tiny change): - http://www.emacswiki.org/PythonProgrammingInEmacs#toc14 + https://www.emacswiki.org/PythonProgrammingInEmacs#toc14 2011-11-16 Juanma Barranquero <lekktu@gmail.com> diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index 8039e3f28a3..5789445fcd6 100644 --- a/lisp/ChangeLog.17 +++ b/lisp/ChangeLog.17 @@ -23951,7 +23951,7 @@ * simple.el (shell-command-on-region): Pass the `replace' argument down to `call-process-region' to comply with the doc as reported on - <http://stackoverflow.com/questions/16720458/emacs-noninteractive-call-to-shell-command-on-region-always-deletes-region> + <https://stackoverflow.com/questions/16720458/emacs-noninteractive-call-to-shell-command-on-region-always-deletes-region> 2013-05-23 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/abbrev.el b/lisp/abbrev.el index dc52a220125..f35c637eed5 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -189,17 +189,21 @@ the ones defined from the buffer now." (table (read buf)) abbrevs name hook exp count sys) (forward-line 1) - (while (progn (forward-line 1) - (not (eolp))) - (setq name (read buf) count (read buf)) - (if (equal count '(sys)) - (setq sys t count (read buf)) - (setq sys nil)) - (setq exp (read buf)) - (skip-chars-backward " \t\n\f") - (setq hook (if (not (eolp)) (read buf))) - (skip-chars-backward " \t\n\f") - (setq abbrevs (cons (list name exp hook count sys) abbrevs))) + (while (and (not (eobp)) + ;; Advance as long as we're looking at blank lines + ;; or we have an abbrev. + (looking-at "[ \t\n]\\|\\(\"\\)")) + (when (match-string 1) + (setq name (read buf) count (read buf)) + (if (equal count '(sys)) + (setq sys t count (read buf)) + (setq sys nil)) + (setq exp (read buf)) + (skip-chars-backward " \t\n\f") + (setq hook (if (not (eolp)) (read buf))) + (skip-chars-backward " \t\n\f") + (setq abbrevs (cons (list name exp hook count sys) abbrevs))) + (forward-line 1)) (define-abbrev-table table abbrevs))))) (defun read-abbrev-file (&optional file quietly) diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index c3b2d98c140..d20260b185c 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -39,7 +39,7 @@ ;; ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48 ;; standard (identical to ISO/IEC 6429), which is freely available as a -;; PDF file <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>. +;; PDF file <URL:https://www.ecma-international.org/publications/standards/Ecma-048.htm>. ;; The "Graphic Rendition Combination Mode (GRCM)" implemented is ;; "cumulative mode" as defined in section 7.2.8. Cumulative mode ;; means that whenever possible, SGR control sequences are combined @@ -84,7 +84,7 @@ This translation effectively colorizes strings and regions based upon SGR control sequences embedded in the text. SGR (Select Graphic Rendition) control sequences are defined in section 8.3.117 of the ECMA-48 standard (identical to ISO/IEC 6429), which is freely available -at <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm> +at <URL:https://www.ecma-international.org/publications/standards/Ecma-048.htm> as a PDF file." :version "21.1" :group 'processes) diff --git a/lisp/bindings.el b/lisp/bindings.el index 3930f5b52c6..250234e94c1 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -918,6 +918,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key narrow-map "n" 'narrow-to-region) (define-key narrow-map "w" 'widen) +(define-key narrow-map "g" 'goto-line-relative) ;; Quitting (define-key global-map "\e\e\e" 'keyboard-escape-quit) diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 05bb3164e12..07562f62240 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -490,8 +490,8 @@ Uses binary search." (utmin (+ ut (* direction 12.0))) (utmax ut) ; the time searched is between utmin and utmax ;; utmin and utmax are in hours. - (utmoment-old 0.0) ; rise or set approximation - (utmoment 1.0) ; rise or set approximation + (utmoment-old utmin) ; rise or set approximation + (utmoment utmax) ; rise or set approximation (hut 0) ; sun height at utmoment (t0 (car time)) (hmin (cadr (solar-horizontal-coordinates (list t0 utmin) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index f60c9c2ffd3..cf6c20afbd2 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -278,6 +278,10 @@ Lower-case specifiers return only the unit. optional leading \".\" for zero-padding. For example, \"%.3Y\" will return something of the form \"001 year\". +The \"%s\" spec takes an additional optional parameter, +introduced by the \",\" character, to say how many decimals to +use. \"%,1s\" means \"use one decimal\". + The \"%z\" specifier does not print anything. When it is used, specifiers must be given in order of decreasing size. To the left of \"%z\", nothing is output until the first non-zero unit is encountered." @@ -289,10 +293,11 @@ is output until the first non-zero unit is encountered." ("s" "second" 1) ("z"))) (case-fold-search t) - spec match usedunits zeroflag larger prev name unit num zeropos) - (while (string-match "%\\.?[0-9]*\\(.\\)" string start) + spec match usedunits zeroflag larger prev name unit num zeropos + fraction) + (while (string-match "%\\.?[0-9]*\\(,[0-9]\\)?\\(.\\)" string start) (setq start (match-end 0) - spec (match-string 1 string)) + spec (match-string 2 string)) (unless (string-equal spec "%") (or (setq match (assoc (downcase spec) units)) (error "Bad format specifier: `%s'" spec)) @@ -307,12 +312,17 @@ is output until the first non-zero unit is encountered." (push match usedunits))) (and zeroflag larger (error "Units are not in decreasing order of size")) - (setq seconds (time-convert seconds 'integer)) + (unless (numberp seconds) + (setq seconds (float-time seconds))) + (setq fraction (mod seconds 1) + seconds (round seconds)) (dolist (u units) (setq spec (car u) name (cadr u) unit (nth 2 u)) - (when (string-match (format "%%\\(\\.?[0-9]+\\)?\\(%s\\)" spec) string) + (when (string-match + (format "%%\\(\\.?[0-9]+\\)?\\(,[0-9]+\\)?\\(%s\\)" spec) + string) (if (string-equal spec "z") ; must be last in units (setq string (replace-regexp-in-string @@ -327,9 +337,23 @@ is output until the first non-zero unit is encountered." (setq zeropos (unless (zerop num) (match-beginning 0)))) (setq string (replace-match - (format (concat "%" (match-string 1 string) "d%s") num - (if (string-equal (match-string 2 string) spec) - "" ; lower-case, no unit-name + (format (if (match-string 2 string) + (concat + "%" + (and (match-string 1 string) + (if (= (elt (match-string 1 string) 0) ?.) + (concat "0" (substring + (match-string 1 string) 1)) + (match-string 1 string))) + (concat "." (substring + (match-string 2 string) 1)) + "f%s") + (concat "%" (match-string 1 string) "d%s")) + (if (= unit 1) + (+ num fraction) + num) + (if (string-equal (match-string 3 string) spec) + "" ; lower-case, no unit-name (format " %s%s" name (if (= num 1) "" "s")))) t t string)))))) diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index db539450e62..1d6a082c5d3 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -96,15 +96,12 @@ of the anchor file for the project." (defun ede--put-inode-dir-hash (dir inode) "Add to the EDE project hash DIR associated with INODE." - (when (fboundp 'puthash) - (puthash dir inode ede-inode-directory-hash) - inode)) + (puthash dir inode ede-inode-directory-hash) + inode) (defun ede--get-inode-dir-hash (dir) "Get the EDE project hash DIR associated with INODE." - (when (fboundp 'gethash) - (gethash dir ede-inode-directory-hash) - )) + (gethash dir ede-inode-directory-hash)) (defun ede--inode-for-dir (dir) "Return the inode for the directory DIR." @@ -272,28 +269,24 @@ Do this only when developing new projects that are incorrectly putting Do this whenever a new project is created, as opposed to loaded." ;; TODO - Use maphash, and delete by regexp, not by dir searching! (setq dir (expand-file-name dir)) - (when (fboundp 'remhash) - (remhash (file-name-as-directory dir) ede-project-directory-hash) - ;; Look for all subdirs of D, and remove them. - (let ((match (concat "^" (regexp-quote dir)))) - (maphash (lambda (K O) - (when (string-match match K) - (remhash K ede-project-directory-hash))) - ede-project-directory-hash)) - )) + (remhash (file-name-as-directory dir) ede-project-directory-hash) + ;; Look for all subdirs of D, and remove them. + (let ((match (concat "^" (regexp-quote dir)))) + (maphash (lambda (K O) + (when (string-match match K) + (remhash K ede-project-directory-hash))) + ede-project-directory-hash))) (defun ede--directory-project-from-hash (dir) "If there is an already loaded project for DIR, return it from the hash." - (when (fboundp 'gethash) - (setq dir (expand-file-name dir)) - (gethash dir ede-project-directory-hash nil))) + (setq dir (expand-file-name dir)) + (gethash dir ede-project-directory-hash nil)) (defun ede--directory-project-add-description-to-hash (dir desc) "Add to the EDE project hash DIR associated with DESC." - (when (fboundp 'puthash) - (setq dir (expand-file-name dir)) - (puthash dir desc ede-project-directory-hash) - desc)) + (setq dir (expand-file-name dir)) + (puthash dir desc ede-project-directory-hash) + desc) ;;; DIRECTORY-PROJECT-P, -CONS ;; diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index 49b0fd1b3b4..0ff9cde80ef 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -427,7 +427,7 @@ Menu items are appended to the common grammar menu.") "\n;; It is derived from the grammar in the ECMAScript Language ;; Specification published at ;; -;; http://www.ecma-international.org/publications/standards/Ecma-262.htm +;; https://www.ecma-international.org/publications/standards/Ecma-262.htm ;; ;; and redistributed under the following license: ;; diff --git a/lisp/comint.el b/lisp/comint.el index 944e1ae8c06..2873416c5f4 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -611,6 +611,7 @@ The command \\[comint-accumulate] sets this.") (put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand) (put 'comint-input-ring 'permanent-local t) +(put 'comint-input-ring-file-name 'permanent-local t) (put 'comint-input-ring-index 'permanent-local t) (put 'comint-save-input-ring-index 'permanent-local t) (put 'comint-input-autoexpand 'permanent-local t) diff --git a/lisp/composite.el b/lisp/composite.el index 47d91c5d212..0a8dcb875c9 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -747,7 +747,18 @@ All non-spacing characters have this function in unicode-category-table)) ;; for dotted-circle (aset composition-function-table #x25CC - `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle]))) + `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle])) + ;; For prettier display of fractions + (set-char-table-range + composition-function-table + #x2044 + ;; We use font-shape-gstring so that if the font doesn't support + ;; fractional display, the characters are shown separately, not as + ;; a composed cluster. + (list (vector (purecopy "[1-9][0-9][0-9]\u2044[0-9]+") + 3 'font-shape-gstring) + (vector (purecopy "[1-9][0-9]\u2044[0-9]+") 2 'font-shape-gstring) + (vector (purecopy "[1-9]\u2044[0-9]+") 1 'font-shape-gstring)))) (defun compose-gstring-for-terminal (gstring _direction) "Compose glyph-string GSTRING for terminal display. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 85c197b400f..769a69a50f2 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -3739,6 +3739,14 @@ the present value is saved to its :shown-value property instead." (widget-put widget :children children) (custom-face-state-set widget)))))) +(defun cus--face-link (widget _format) + (widget-create-child-and-convert + widget 'face-link + :button-face 'link + :tag "link" + :action (lambda (&rest _x) + (customize-face (widget-value widget))))) + (defvar custom-face-menu nil "If non-nil, an alist of actions for the `custom-face' widget. @@ -4008,7 +4016,7 @@ restoring it to the state of a face that has never been customized." (define-widget 'face 'symbol "A Lisp face name (with sample)." - :format "%{%t%}: (%{sample%}) %v" + :format "%f %{%t%}: (%{sample%}) %v" :tag "Face" :value 'default :sample-face-get 'widget-face-sample-face-get @@ -4018,6 +4026,7 @@ restoring it to the state of a face that has never been customized." obarray #'facep 'strict) :prompt-match 'facep :prompt-history 'widget-face-prompt-value-history + :format-handler 'cus--face-link :validate (lambda (widget) (unless (facep (widget-value widget)) (widget-put widget diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 3fd6ac031c0..6927b6df6b8 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -324,9 +324,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (resize-mini-frames frames (choice (const :tag "Never" nil) - (const :tag "Fit frame to buffer" t) + (const :tag "Fit mini frame to buffer" t) (function :tag "User-defined function")) - "27.1") + "27.2") (menu-bar-mode frames boolean nil ;; FIXME? ;; :initialize custom-initialize-default diff --git a/lisp/delsel.el b/lisp/delsel.el index 16886dfdb12..df2adc7aeba 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -217,6 +217,10 @@ With ARG, repeat that many times. `C-u' means until end of buffer." (self-insert-command (prefix-numeric-value current-prefix-arg)) (setq this-command 'ignore))))) + ;; If the user has quit here (for instance, if the user is + ;; presented with a "changed on disk; really edit the buffer?" + ;; prompt, but hit `C-g'), just ding. + (quit (ding)) ;; If ask-user-about-supersession-threat signals an error, ;; stop safe_run_hooks from clearing out pre-command-hook. (file-supersession (message "%s" (cadr data)) (ding)) diff --git a/lisp/display-fill-column-indicator.el b/lisp/display-fill-column-indicator.el index e1395f000bf..5fd9f07cd46 100644 --- a/lisp/display-fill-column-indicator.el +++ b/lisp/display-fill-column-indicator.el @@ -51,6 +51,8 @@ This uses `display-fill-column-indicator' internally. To change the position of the column displayed by default customize `display-fill-column-indicator-column'. You can change the character for the indicator setting `display-fill-column-indicator-character'. +The globalized version is `global-display-fill-column-indicator-mode', +which see. See Info node `Displaying Boundaries' for details." :lighter nil (if display-fill-column-indicator-mode @@ -74,7 +76,8 @@ See Info node `Displaying Boundaries' for details." ;;;###autoload (define-globalized-minor-mode global-display-fill-column-indicator-mode - display-fill-column-indicator-mode display-fill-column-indicator--turn-on) + display-fill-column-indicator-mode display-fill-column-indicator--turn-on + :predicate '((not special-mode) t)) (provide 'display-fill-column-indicator) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 95581c40a46..0fd273aa3e3 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -1,4 +1,4 @@ -;;; bindat.el --- binary data structure packing and unpacking. -*- lexical-binding: t -*- +;;; bindat.el --- binary data structure packing and unpacking. ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. @@ -193,8 +193,8 @@ ;; Helper functions for structure unpacking. ;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX -(defvar bindat-raw nil) -(defvar bindat-idx nil) +(defvar bindat-raw) +(defvar bindat-idx) (defun bindat--unpack-u8 () (prog1 @@ -276,7 +276,7 @@ (t nil))) (defun bindat--unpack-group (spec) - (let (struct) + (let (struct last) (while spec (let* ((item (car spec)) (field (car item)) @@ -330,21 +330,21 @@ (setq data (bindat--unpack-group (cdr case)) cases nil))))) (t - (setq data (bindat--unpack-item type len vectype)))) + (setq data (bindat--unpack-item type len vectype) + last data))) (if data (if field (setq struct (cons (cons field data) struct)) (setq struct (append data struct)))))) struct)) -(defun bindat-unpack (spec raw &optional idx) - "Return structured data according to SPEC for binary data in RAW. -RAW is a unibyte string or vector. -Optional third arg IDX specifies the starting offset in RAW." - (when (multibyte-string-p raw) +(defun bindat-unpack (spec bindat-raw &optional bindat-idx) + "Return structured data according to SPEC for binary data in BINDAT-RAW. +BINDAT-RAW is a unibyte string or vector. +Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW." + (when (multibyte-string-p bindat-raw) (error "String is multibyte")) - (setq bindat-raw raw) - (setq bindat-idx (or idx 0)) + (unless bindat-idx (setq bindat-idx 0)) (bindat--unpack-group spec)) (defun bindat-get-field (struct &rest field) @@ -373,70 +373,74 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (ip . 4))) (defun bindat--length-group (struct spec) - (while spec - (let* ((item (car spec)) - (field (car item)) - (type (nth 1 item)) - (len (nth 2 item)) - (vectype (and (eq type 'vec) (nth 3 item))) - (tail 3)) - (setq spec (cdr spec)) - (if (and (consp field) (eq (car field) 'eval)) - (setq field (eval (car (cdr field))))) - (if (and type (consp type) (eq (car type) 'eval)) - (setq type (eval (car (cdr type))))) - (if (and len (consp len) (eq (car len) 'eval)) - (setq len (eval (car (cdr len))))) - (if (memq field '(eval fill align struct union)) - (setq tail 2 - len type - type field - field nil)) - (if (and (consp len) (not (eq type 'eval))) - (setq len (apply #'bindat-get-field struct len))) - (if (not len) - (setq len 1)) - (while (eq type 'vec) - (if (consp vectype) - (setq len (* len (nth 1 vectype)) - type (nth 2 vectype)) - (setq type (or vectype 'u8) - vectype nil))) - (cond - ((eq type 'eval) - (if field - (setq struct (cons (cons field (eval len)) struct)) - (eval len))) - ((eq type 'fill) - (setq bindat-idx (+ bindat-idx len))) - ((eq type 'align) - (while (/= (% bindat-idx len) 0) - (setq bindat-idx (1+ bindat-idx)))) - ((eq type 'struct) - (bindat--length-group - (if field (bindat-get-field struct field) struct) (eval len))) - ((eq type 'repeat) - (let ((index 0) (count len)) - (while (< index count) - (bindat--length-group - (nth index (bindat-get-field struct field)) - (nthcdr tail item)) - (setq index (1+ index))))) - ((eq type 'union) - (let ((tag len) (cases (nthcdr tail item)) case cc) - (while cases - (setq case (car cases) - cases (cdr cases) - cc (car case)) - (if (or (equal cc tag) (equal cc t) - (and (consp cc) (eval cc))) - (progn - (bindat--length-group struct (cdr case)) - (setq cases nil)))))) - (t - (if (setq type (assq type bindat--fixed-length-alist)) - (setq len (* len (cdr type)))) - (setq bindat-idx (+ bindat-idx len))))))) + (let (last) + (while spec + (let* ((item (car spec)) + (field (car item)) + (type (nth 1 item)) + (len (nth 2 item)) + (vectype (and (eq type 'vec) (nth 3 item))) + (tail 3)) + (setq spec (cdr spec)) + (if (and (consp field) (eq (car field) 'eval)) + (setq field (eval (car (cdr field))))) + (if (and type (consp type) (eq (car type) 'eval)) + (setq type (eval (car (cdr type))))) + (if (and len (consp len) (eq (car len) 'eval)) + (setq len (eval (car (cdr len))))) + (if (memq field '(eval fill align struct union)) + (setq tail 2 + len type + type field + field nil)) + (if (and (consp len) (not (eq type 'eval))) + (setq len (apply 'bindat-get-field struct len))) + (if (not len) + (setq len 1)) + (while (eq type 'vec) + (let ((vlen 1)) + (if (consp vectype) + (setq len (* len (nth 1 vectype)) + type (nth 2 vectype)) + (setq type (or vectype 'u8) + vectype nil)))) + (cond + ((eq type 'eval) + (if field + (setq struct (cons (cons field (eval len)) struct)) + (eval len))) + ((eq type 'fill) + (setq bindat-idx (+ bindat-idx len))) + ((eq type 'align) + (while (/= (% bindat-idx len) 0) + (setq bindat-idx (1+ bindat-idx)))) + ((eq type 'struct) + (bindat--length-group + (if field (bindat-get-field struct field) struct) (eval len))) + ((eq type 'repeat) + (let ((index 0) (count len)) + (while (< index count) + (bindat--length-group + (nth index (bindat-get-field struct field)) + (nthcdr tail item)) + (setq index (1+ index))))) + ((eq type 'union) + (let ((tag len) (cases (nthcdr tail item)) case cc) + (while cases + (setq case (car cases) + cases (cdr cases) + cc (car case)) + (if (or (equal cc tag) (equal cc t) + (and (consp cc) (eval cc))) + (progn + (bindat--length-group struct (cdr case)) + (setq cases nil)))))) + (t + (if (setq type (assq type bindat--fixed-length-alist)) + (setq len (* len (cdr type)))) + (if field + (setq last (bindat-get-field struct field))) + (setq bindat-idx (+ bindat-idx len)))))))) (defun bindat-length (spec struct) "Calculate bindat-raw length for STRUCT according to bindat SPEC." @@ -592,17 +596,17 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-item last type len vectype) )))))) -(defun bindat-pack (spec struct &optional raw idx) +(defun bindat-pack (spec struct &optional bindat-raw bindat-idx) "Return binary data packed according to SPEC for structured data STRUCT. -Optional third arg RAW is a pre-allocated unibyte string or -vector to pack into. -Optional fourth arg IDX is the starting offset into BINDAT-RAW." - (when (multibyte-string-p raw) +Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to +pack into. +Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW." + (when (multibyte-string-p bindat-raw) (error "Pre-allocated string is multibyte")) - (let ((no-return raw)) - (setq bindat-idx (or idx 0)) - (setq bindat-raw (or raw - (make-string (+ bindat-idx (bindat-length spec struct)) 0))) + (let ((no-return bindat-raw)) + (unless bindat-idx (setq bindat-idx 0)) + (unless bindat-raw + (setq bindat-raw (make-string (+ bindat-idx (bindat-length spec struct)) 0))) (bindat--pack-group struct spec) (if no-return nil bindat-raw))) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 65e4e446266..1dc83dd3958 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -830,11 +830,13 @@ (defun byte-optimize-assoc (form) ;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq', ;; if the first arg is a symbol. - (if (and (= (length form) 3) - (byte-optimize--constant-symbol-p (nth 1 form))) - (cons (if (eq (car form) 'assoc) 'assq 'rassq) - (cdr form)) - form)) + (cond + ((/= (length form) 3) + form) + ((byte-optimize--constant-symbol-p (nth 1 form)) + (cons (if (eq (car form) 'assoc) 'assq 'rassq) + (cdr form))) + (t (byte-optimize-constant-args form)))) (defun byte-optimize-memq (form) ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar)) @@ -1144,7 +1146,7 @@ ;; I wonder if I missed any :-\) (let ((side-effect-free-fns '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan - assoc assq + assq boundp buffer-file-name buffer-local-variables buffer-modified-p buffer-substring byte-code-function-p capitalize car-less-than-car car cdr ceiling char-after char-before diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1e2ce8cd130..a3c830e60dd 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1989,7 +1989,7 @@ See also `emacs-lisp-byte-compile-and-load'." (byte-compile--known-dynamic-vars (byte-compile--load-dynvars (getenv "EMACS_DYNVARS_FILE"))) target-file input-buffer output-buffer - byte-compile-dest-file) + byte-compile-dest-file byte-compiler-error-flag) (setq target-file (byte-compile-dest-file filename)) (setq byte-compile-dest-file target-file) (with-current-buffer @@ -2051,7 +2051,6 @@ See also `emacs-lisp-byte-compile-and-load'." 'no-byte-compile) (when byte-compile-verbose (message "Compiling %s..." filename)) - (setq byte-compiler-error-flag nil) ;; It is important that input-buffer not be current at this call, ;; so that the value of point set in input-buffer ;; within byte-compile-from-buffer lingers in that buffer. diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 23121c245ef..a485378a926 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2589,7 +2589,7 @@ This function will not modify `match-data'." ;; going on. (if checkdoc-bouncy-flag (message "%s -> done" question)) (delete-region start end) - (insert replacewith) + (insert-before-markers replacewith) (if checkdoc-bouncy-flag (sit-for 0)) (setq ret t))) (delete-overlay o) diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 6fa51c3f644..9828ca63ebc 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -1,4 +1,4 @@ -;;; copyright.el --- update the copyright notice in current buffer +;;; copyright.el --- update the copyright notice in current buffer -*- lexical-binding: t -*- ;; Copyright (C) 1991-1995, 1998, 2001-2020 Free Software Foundation, ;; Inc. @@ -37,14 +37,12 @@ (defcustom copyright-limit 2000 "Don't try to update copyright beyond this position unless interactive. A value of nil means to search whole buffer." - :group 'copyright :type '(choice (integer :tag "Limit") (const :tag "No limit"))) (defcustom copyright-at-end-flag nil "Non-nil means to search backwards from the end of the buffer for copyright. This is useful for ChangeLogs." - :group 'copyright :type 'boolean :version "23.1") ;;;###autoload(put 'copyright-at-end-flag 'safe-local-variable 'booleanp) @@ -56,7 +54,6 @@ This is useful for ChangeLogs." \\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" "What your copyright notice looks like. The second \\( \\) construct must match the years." - :group 'copyright :type 'regexp) (defcustom copyright-names-regexp "" @@ -64,7 +61,6 @@ The second \\( \\) construct must match the years." Only copyright lines where the name matches this regexp will be updated. This allows you to avoid adding years to a copyright notice belonging to someone else or to a group for which you do not work." - :group 'copyright :type 'regexp) ;; The worst that can happen is a malicious regexp that overflows in @@ -76,7 +72,6 @@ someone else or to a group for which you do not work." "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" "Match additional copyright notice years. The second \\( \\) construct must match the years." - :group 'copyright :type 'regexp) ;; See "Copyright Notices" in maintain.info. @@ -87,7 +82,6 @@ The second \\( \\) construct must match the years." For example: 2005, 2006, 2007, 2008 might be replaced with 2005-2008. If you use ranges, you should add an explanatory note in a README file. The function `copyright-fix-years' respects this variable." - :group 'copyright :type 'boolean :version "24.1") @@ -96,7 +90,6 @@ The function `copyright-fix-years' respects this variable." (defcustom copyright-query 'function "If non-nil, ask user before changing copyright. When this is `function', only ask when called non-interactively." - :group 'copyright :type '(choice (const :tag "Do not ask") (const :tag "Ask unless interactive" function) (other :tag "Ask" t))) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 8c1e5b227a6..a707d204f8b 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -375,18 +375,21 @@ No problems result if this variable is not bound. (defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body) "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE. TURN-ON is a function that will be called with no args in every buffer - and that should try to turn MODE on if applicable for that buffer. -Each of KEY VALUE is a pair of CL-style keyword arguments. As - the minor mode defined by this function is always global, any - :global keyword is ignored. Other keywords have the same - meaning as in `define-minor-mode', which see. In particular, - :group specifies the custom group. The most useful keywords - are those that are passed on to the `defcustom'. It normally - makes no sense to pass the :lighter or :keymap keywords to - `define-globalized-minor-mode', since these are usually passed - to the buffer-local version of the minor mode. +and that should try to turn MODE on if applicable for that buffer. + +Each of KEY VALUE is a pair of CL-style keyword arguments. :predicate +specifies which major modes the globalized minor mode should be switched on +in. As the minor mode defined by this function is always global, any +:global keyword is ignored. Other keywords have the same meaning as in +`define-minor-mode', which see. In particular, :group specifies the custom +group. The most useful keywords are those that are passed on to the +`defcustom'. It normally makes no sense to pass the :lighter or :keymap +keywords to `define-globalized-minor-mode', since these are usually passed +to the buffer-local version of the minor mode. + BODY contains code to execute each time the mode is enabled or disabled. - It is executed after toggling the mode, and before running GLOBAL-MODE-hook. +It is executed after toggling the mode, and before running +GLOBAL-MODE-hook. If MODE's set-up depends on the major mode in effect when it was enabled, then disabling and reenabling MODE should make MODE work @@ -415,7 +418,11 @@ on if the hook has explicitly disabled it. (minor-MODE-hook (intern (concat mode-name "-hook"))) (MODE-set-explicitly (intern (concat mode-name "-set-explicitly"))) (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode"))) - keyw) + (MODE-predicate (intern (concat (replace-regexp-in-string + "-mode\\'" "" global-mode-name) + "-modes"))) + (turn-on-function `#',turn-on) + keyw predicate) ;; Check keys. (while (keywordp (setq keyw (car body))) @@ -423,6 +430,13 @@ on if the hook has explicitly disabled it. (pcase keyw (:group (setq group (nconc group (list :group (pop body))))) (:global (pop body)) + (:predicate + (setq predicate (list (pop body))) + (setq turn-on-function + `(lambda () + (require 'easy-mmode) + (when (easy-mmode--globalized-predicate-p ,(car predicate)) + (funcall ,turn-on-function))))) (_ (push keyw extra-keywords) (push (pop body) extra-keywords)))) `(progn @@ -442,10 +456,17 @@ ARG is omitted or nil. %s is enabled in all buffers where `%s' would do it. -See `%s' for more information on %s." + +See `%s' for more information on +%s.%s" pretty-name pretty-global-name - pretty-name turn-on mode pretty-name) - :global t ,@group ,@(nreverse extra-keywords) + pretty-name turn-on mode pretty-name + (if predicate + (format "\n\n`%s' is used to control which modes +this minor mode is used in." + MODE-predicate) + "")) + :global t ,@group ,@(nreverse extra-keywords) ;; Setup hook to handle future mode changes and new buffers. (if ,global-mode @@ -461,9 +482,28 @@ See `%s' for more information on %s." ;; Go through existing buffers. (dolist (buf (buffer-list)) (with-current-buffer buf - (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1))))) + (if ,global-mode (funcall ,turn-on-function) + (when ,mode (,mode -1))))) ,@body) + ,(when predicate + `(defcustom ,MODE-predicate ,(car predicate) + ,(format "Which major modes `%s' is switched on in. +This variable can be either t (all major modes), nil (no major modes), +or a list of modes and (not modes) to switch use this minor mode or +not. For instance + + (c-mode (not message-mode mail-mode) text-mode) + +means \"use this mode in all modes derived from `c-mode', don't use in +modes derived from `message-mode' or `mail-mode', but do use in other +modes derived from `text-mode'\". An element with value t means \"use\" +and nil means \"don't use\". There's an implicit nil at the end of the +list." + mode) + :type '(repeat sexp) + :group ,group)) + ;; Autoloading define-globalized-minor-mode autoloads everything ;; up-to-here. :autoload-end @@ -497,8 +537,8 @@ See `%s' for more information on %s." (if ,mode (progn (,mode -1) - (funcall #',turn-on)) - (funcall #',turn-on)))) + (funcall ,turn-on-function)) + (funcall ,turn-on-function)))) (setq ,MODE-major-mode major-mode)))))) (put ',MODE-enable-in-buffers 'definition-name ',global-mode) @@ -513,6 +553,33 @@ See `%s' for more information on %s." (add-hook 'post-command-hook ',MODE-check-buffers)) (put ',MODE-cmhh 'definition-name ',global-mode)))) +(defun easy-mmode--globalized-predicate-p (predicate) + (cond + ((eq predicate t) + t) + ((eq predicate nil) + nil) + ((listp predicate) + ;; Legacy support for (not a b c). + (when (eq (car predicate) 'not) + (setq predicate (nconc (mapcar (lambda (e) (list 'not e)) + (cdr predicate)) + (list t)))) + (catch 'found + (dolist (elem predicate) + (cond + ((eq elem t) + (throw 'found t)) + ((eq elem nil) + (throw 'found nil)) + ((and (consp elem) + (eq (car elem) 'not)) + (when (apply #'derived-mode-p (cdr elem)) + (throw 'found nil))) + ((symbolp elem) + (when (derived-mode-p elem) + (throw 'found t))))))))) + ;;; ;;; easy-mmode-defmap ;;; diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f10dc13fa07..fe733630bad 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2665,9 +2665,6 @@ See `edebug-behavior-alist' for implementations.") (defvar edebug-previous-result nil) ;; Last result returned. -;; Emacs 19 adds an arg to mark and mark-marker. -(defalias 'edebug-mark-marker 'mark-marker) - (defun edebug--display (value offset-index arg-mode) ;; edebug--display-1 is too big, we should split it. This function ;; here was just introduced to avoid making edebug--display-1 @@ -2895,8 +2892,8 @@ See `edebug-behavior-alist' for implementations.") ;; But don't restore point if edebug-buffer is current buffer. (if (not (eq edebug-buffer edebug-outside-buffer)) (goto-char edebug-outside-point)) - (if (marker-buffer (edebug-mark-marker)) - (set-marker (edebug-mark-marker) edebug-outside-mark)) + (if (marker-buffer (mark-marker)) + (set-marker (mark-marker) edebug-outside-mark)) )) ; unwind-protect ;; None of the following is done if quit or signal occurs. @@ -3153,8 +3150,8 @@ before returning. The default is one second." (goto-char edebug-outside-point) (message "Current buffer: %s Point: %s Mark: %s" (current-buffer) (point) - (if (marker-buffer (edebug-mark-marker)) - (marker-position (edebug-mark-marker)) "<not set>")) + (if (marker-buffer (mark-marker)) + (marker-position (mark-marker)) "<not set>")) (sit-for arg) (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) @@ -3725,8 +3722,8 @@ Return the result of the last expression." ;; for us. (with-current-buffer edebug-outside-buffer ; of edebug-buffer (goto-char edebug-outside-point) - (if (marker-buffer (edebug-mark-marker)) - (set-marker (edebug-mark-marker) edebug-outside-mark)) + (if (marker-buffer (mark-marker)) + (set-marker (mark-marker) edebug-outside-mark)) ,@body) ;; Back to edebug-buffer. Restore rest of inside context. @@ -4667,5 +4664,7 @@ instrumentation for, defaulting to all functions." (message "Removed edebug instrumentation from %s" (mapconcat #'symbol-name functions ", "))) +(define-obsolete-function-alias 'edebug-mark-marker #'mark-marker "28.1") + (provide 'edebug) ;;; edebug.el ends here diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 9e38e5908ed..78cb8f08c34 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -5,7 +5,7 @@ ;; Author: Noah Friedman <friedman@splode.com> ;; Keywords: extensions ;; Created: 1995-10-06 -;; Version: 1.10.0 +;; Version: 1.11.0 ;; Package-Requires: ((emacs "26.3")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -67,7 +67,7 @@ If this variable is set to 0, no idle time is required." Changing the value requires toggling `eldoc-mode'." :type 'boolean) -(defcustom eldoc-display-truncation-message t +(defcustom eldoc-echo-area-display-truncation-message t "If non-nil, provide verbose help when a message has been truncated. If nil, truncated messages will just have \"...\" appended." :type 'boolean @@ -96,19 +96,22 @@ Note that this variable has no effect, unless If value is t, never attempt to truncate messages, even if the echo area must be resized to fit. -If value is a number (integer or floating point), it has the -semantics of `max-mini-window-height', constraining the resizing -for ElDoc purposes only. +If the value is a positive number, it is used to calculate a +number of logical lines of documentation that ElDoc is allowed to +put in the echo area. If a positive integer, the number is used +directly, while a float specifies the number of lines as a +proporting of the echo area frame's height. -Any resizing respects `max-mini-window-height'. - -If value is any non-nil symbol other than t, the part of the doc -string that represents the symbol's name may be truncated if it -will enable the rest of the doc string to fit on a single line, -without resizing the echo area. +If value is the symbol `truncate-sym-name-if-fit' t, the part of +the doc string that represents a symbol's name may be truncated +if it will enable the rest of the doc string to fit on a single +line, without resizing the echo area. If value is nil, a doc string is always truncated to fit in a -single line of display in the echo area." +single line of display in the echo area. + +Any resizing of the echo area additionally respects +`max-mini-window-height'." :type '(radio (const :tag "Always" t) (float :tag "Fraction of frame height" 0.25) (integer :tag "Number of lines" 5) @@ -117,12 +120,13 @@ single line of display in the echo area." symbol names if it will\ enable argument list to fit on one line" truncate-sym-name-if-fit))) -(defcustom eldoc-prefer-doc-buffer nil +(defcustom eldoc-echo-area-prefer-doc-buffer nil "Prefer ElDoc's documentation buffer if it is showing in some frame. -If this variable's value is t and a piece of documentation needs -to be truncated to fit in the echo area, do so if ElDoc's -documentation buffer is not already showing, since the buffer -always holds the full documentation." +If this variable's value is t, ElDoc will skip showing +documentation in the echo area if the dedicated documentation +buffer (given by `eldoc-doc-buffer') is being displayed in some +window. If the value is the symbol `maybe', then the echo area +is only skipped if the documentation doesn't fit there." :type 'boolean) (defface eldoc-highlight-function-argument @@ -237,8 +241,9 @@ expression point is on." :lighter eldoc-minor-mode-string ;; `emacs-lisp-mode' itself? (cond ((<= emacs-major-version 27) (declare-function elisp-eldoc-documentation-function "elisp-mode") - (add-function :before-until (local 'eldoc-documentation-function) - #'elisp-eldoc-documentation-function)) + (with-no-warnings + (add-function :before-until (local 'eldoc-documentation-function) + #'elisp-eldoc-documentation-function))) (t (add-hook 'eldoc-documentation-functions #'elisp-eldoc-var-docstring nil t) (add-hook 'eldoc-documentation-functions @@ -350,40 +355,26 @@ Also store it in `eldoc-last-message' and return that value." ;; for us, but do note that the last-message will be gone. (setq eldoc-last-message nil)))) -(defvar-local eldoc--last-request-state nil +;; The point of `eldoc--request-state' is not to over-request, which +;; can happen if the idle timer is restarted on execution of command +;; which is guaranteed not to change the conditions that warrant a new +;; request for documentation. +(defvar eldoc--last-request-state nil "Tuple containing information about last ElDoc request.") (defun eldoc--request-state () "Compute information to store in `eldoc--last-request-state'." (list (current-buffer) (buffer-modified-tick) (point))) (defun eldoc-display-message-p () - (eldoc--request-docs-p (eldoc--request-state))) + "Tell if ElDoc can use the echo area." + (and (eldoc-display-message-no-interference-p) + (not this-command) + (eldoc--message-command-p last-command))) + (make-obsolete 'eldoc-display-message-p "Use `eldoc-documentation-functions' instead." "eldoc-1.6.0") -(defun eldoc--request-docs-p (request-state) - "Return non-nil when it is appropriate to request docs. -REQUEST-STATE is a candidate for `eldoc--last-request-state'" - (and - ;; FIXME: The original idea behind this function is to protect the - ;; Echo area from ElDoc interference, but since that is only one of - ;; the possible outlets of ElDoc, this must soon be reworked. - (eldoc-display-message-no-interference-p) - (not (and eldoc--doc-buffer - (get-buffer-window eldoc--doc-buffer) - (equal request-state - (with-current-buffer - eldoc--doc-buffer - eldoc--last-request-state)))) - ;; If this-command is non-nil while running via an idle - ;; timer, we're still in the middle of executing a command, - ;; e.g. a query-replace where it would be annoying to - ;; overwrite the echo area. - (not this-command) - (eldoc--message-command-p last-command))) - - ;; Check various conditions about the current environment that might make ;; it undesirable to print eldoc messages right this instant. (defun eldoc-display-message-no-interference-p () @@ -416,43 +407,159 @@ about the context around point. To call the CALLBACK function, the hook function must pass it an obligatory argument DOCSTRING, a string containing the -documentation, followed by an optional list of keyword-value -pairs of the form (:KEY VALUE :KEY2 VALUE2...). KEY can be: - -* `:thing', VALUE is a short string or symbol designating what is - being reported on. The documentation display engine can elect - to remove this information depending on space constraints; - -* `:face', VALUE is a symbol designating a face to use when - displaying `:thing''s value. - -Major modes should modify this hook locally, for example: +documentation, followed by an optional list of arbitrary +keyword-value pairs of the form (:KEY VALUE :KEY2 VALUE2...). +The information contained in these pairs is understood by members +of `eldoc-display-functions', allowing the +documentation-producing backend to cooperate with specific +documentation-displaying frontends. For example, KEY can be: + +* `:thing', VALUE being a short string or symbol designating what + is being reported on. It can, for example be the name of the + function whose signature is being documented, or the name of + the variable whose docstring is being documented. + `eldoc-display-in-echo-area', a member of + `eldoc-display-functions', sometimes omits this information + depending on space constraints; + +* `:face', VALUE being a symbol designating a face which both + `eldoc-display-in-echo-area' and `eldoc-display-in-buffer' will + use when displaying `:thing''s value. + +Finally, major modes should modify this hook locally, for +example: (add-hook \\='eldoc-documentation-functions #\\='foo-mode-eldoc nil t) so that the global value (i.e. the default value of the hook) is taken into account if the major mode specific function does not return any documentation.") +(defvar eldoc-display-functions + '(eldoc-display-in-echo-area eldoc-display-in-buffer) + "Hook of functions tasked with displaying ElDoc results. +Each function is passed two arguments: DOCS and INTERACTIVE. DOCS +is a list (DOC ...) where DOC looks like (STRING :KEY VALUE :KEY2 +VALUE2 ...). STRING is a string containing the documentation's +text and the remainder of DOC is an optional list of +keyword-value pairs denoting additional properties of that +documentation. For commonly recognized properties, see +`eldoc-documentation-functions'. + +INTERACTIVE says if the request to display doc strings came +directly from the user or from ElDoc's automatic mechanisms'.") + (defvar eldoc--doc-buffer nil "Buffer displaying latest ElDoc-produced docs.") -(defun eldoc-doc-buffer (&optional interactive) - "Get latest *eldoc* help buffer. Interactively, display it." +(defvar eldoc--doc-buffer-docs nil "Documentation items in `eldoc--doc-buffer'.") + +(defun eldoc-doc-buffer () + "Display ElDoc documentation buffer. + +This holds the results of the last documentation request." + (interactive) + (unless (buffer-live-p eldoc--doc-buffer) + (user-error (format + "ElDoc buffer doesn't exist, maybe `%s' to produce one." + (substitute-command-keys "\\[eldoc]")))) + (with-current-buffer eldoc--doc-buffer + (rename-buffer (replace-regexp-in-string "^ *" "" + (buffer-name))) + (display-buffer (current-buffer)))) + +(defun eldoc--format-doc-buffer (docs) + "Ensure DOCS are displayed in an *eldoc* buffer." (interactive (list t)) - (prog1 - (if (and eldoc--doc-buffer (buffer-live-p eldoc--doc-buffer)) - eldoc--doc-buffer - (setq eldoc--doc-buffer (get-buffer-create "*eldoc*"))) - (when interactive (display-buffer eldoc--doc-buffer)))) - - -(defun eldoc--handle-docs (docs) - "Display multiple DOCS in echo area. -DOCS is a list of (STRING PLIST...). It is already sorted. -Honor most of `eldoc-echo-area-use-multiline-p'." - ;; If there's nothing to report clear the echo area, but don't erase - ;; the last *eldoc* buffer. - (if (null docs) (eldoc--message nil) + (with-current-buffer (if (buffer-live-p eldoc--doc-buffer) + eldoc--doc-buffer + (setq eldoc--doc-buffer + (get-buffer-create " *eldoc*"))) + (unless (eq docs eldoc--doc-buffer-docs) + (setq-local eldoc--doc-buffer-docs docs) + (let ((inhibit-read-only t) + (things-reported-on)) + (erase-buffer) (setq buffer-read-only t) + (local-set-key "q" 'quit-window) + (cl-loop for (docs . rest) on docs + for (this-doc . plist) = docs + for thing = (plist-get plist :thing) + when thing do + (cl-pushnew thing things-reported-on) + (setq this-doc + (concat + (propertize (format "%s" thing) + 'face (plist-get plist :face)) + ": " + this-doc)) + do (insert this-doc) + when rest do (insert "\n") + finally (goto-char (point-min))) + ;; Rename the buffer, taking into account whether it was + ;; hidden or not + (rename-buffer (format "%s*eldoc%s*" + (if (string-match "^ " (buffer-name)) " " "") + (if things-reported-on + (format " for %s" + (mapconcat + (lambda (s) (format "%s" s)) + things-reported-on + ", ")) + "")))))) + eldoc--doc-buffer) + +(defun eldoc--echo-area-substring (available) + "Given AVAILABLE lines, get buffer substring to display in echo area. +Helper for `eldoc-display-in-echo-area'." + (let ((start (prog1 (progn + (goto-char (point-min)) + (skip-chars-forward " \t\n") + (point)) + (goto-char (line-end-position available)) + (skip-chars-backward " \t\n"))) + (truncated (save-excursion + (skip-chars-forward " \t\n") + (not (eobp))))) + (cond ((eldoc--echo-area-prefer-doc-buffer-p truncated) + nil) + ((and truncated + (> available 1) + eldoc-echo-area-display-truncation-message) + (goto-char (line-end-position 0)) + (concat (buffer-substring start (point)) + (format + "\n(Documentation truncated. Use `%s' to see rest)" + (substitute-command-keys "\\[eldoc-doc-buffer]")))) + (t + (buffer-substring start (point)))))) + +(defun eldoc--echo-area-prefer-doc-buffer-p (truncatedp) + "Tell if display in the echo area should be skipped. +Helper for `eldoc-display-in-echo-area'. If TRUNCATEDP the +documentation to potentially appear in the echo are is truncated." + (and (or (eq eldoc-echo-area-prefer-doc-buffer t) + (and truncatedp + (eq eldoc-echo-area-prefer-doc-buffer + 'maybe))) + (get-buffer-window eldoc--doc-buffer))) + +(defun eldoc-display-in-echo-area (docs _interactive) + "Display DOCS in echo area. +Honor `eldoc-echo-area-use-multiline-p' and +`eldoc-echo-area-prefer-doc-buffer'." + (cond + (;; Check if he wave permission to mess with echo area at all. For + ;; example, if this-command is non-nil while running via an idle + ;; timer, we're still in the middle of executing a command, e.g. a + ;; query-replace where it would be annoying to overwrite the echo + ;; area. + (or + (not (eldoc-display-message-no-interference-p)) + this-command + (not (eldoc--message-command-p last-command)))) + (;; If we do but nothing to report, clear the echo area. + (null docs) + (eldoc--message nil)) + (t + ;; Otherwise, establish some parameters. (let* - ;; Otherwise, establish some parameters. ((width (1- (window-width (minibuffer-window)))) (val (if (and (symbolp eldoc-echo-area-use-multiline-p) eldoc-echo-area-use-multiline-p) @@ -461,44 +568,13 @@ Honor most of `eldoc-echo-area-use-multiline-p'." (available (cl-typecase val (float (truncate (* (frame-height) val))) (integer val) - (t 1))) - (things-reported-on) - (request eldoc--last-request-state) + (t 'just-one-line))) single-doc single-doc-sym) - ;; Then, compose the contents of the `*eldoc*' buffer. - (with-current-buffer (eldoc-doc-buffer) - ;; Set doc-buffer's `eldoc--last-request-state', too - (setq eldoc--last-request-state request) - (let ((inhibit-read-only t)) - (erase-buffer) (setq buffer-read-only t) - (local-set-key "q" 'quit-window) - (cl-loop for (docs . rest) on docs - for (this-doc . plist) = docs - for thing = (plist-get plist :thing) - when thing do - (cl-pushnew thing things-reported-on) - (setq this-doc - (concat - (propertize (format "%s" thing) - 'face (plist-get plist :face)) - ": " - this-doc)) - do (insert this-doc) - when rest do (insert "\n"))) - ;; Rename the buffer. - (when things-reported-on - (rename-buffer (format "*eldoc for %s*" - (mapconcat (lambda (s) (format "%s" s)) - things-reported-on - ", "))))) - ;; Finally, output to the echo area. I'm pretty sure nicer - ;; strategies can be used here, probably by splitting this - ;; function into some `eldoc-display-functions' special hook. (let ((echo-area-message (cond - (;; We handle the `truncate-sym-name-if-fit' special - ;; case first, by checking if for a lot of special - ;; conditions. + (;; To output to the echo area, we handle the + ;; `truncate-sym-name-if-fit' special case first, by + ;; checking for a lot of special conditions. (and (eq 'truncate-sym-name-if-fit eldoc-echo-area-use-multiline-p) (null (cdr docs)) @@ -509,45 +585,32 @@ Honor most of `eldoc-echo-area-use-multiline-p'." (not (string-match "\n" single-doc)) (> (+ (length single-doc) (length single-doc-sym) 2) width)) single-doc) - ((> available 1) - ;; The message takes one extra line, so if we don't - ;; display that, we have one extra line to use. - (unless eldoc-display-truncation-message - (setq available (1+ available))) - (with-current-buffer (eldoc-doc-buffer) - (cl-loop - initially - (goto-char (point-min)) - (goto-char (line-end-position (1+ available))) - for truncated = nil then t - for needed - = (let ((truncate-lines message-truncate-lines)) - (count-screen-lines (point-min) (point) t - (minibuffer-window))) - while (> needed (if truncated (1- available) available)) - do (goto-char (line-end-position (if truncated 0 -1))) - (while (and (not (bobp)) (bolp)) (goto-char (line-end-position 0))) - finally - (unless (and truncated - eldoc-prefer-doc-buffer - (get-buffer-window eldoc--doc-buffer)) - (cl-return - (concat - (buffer-substring (point-min) (point)) - (and - truncated - (if eldoc-display-truncation-message - (format - "\n(Documentation truncated. Use `%s' to see rest)" - (substitute-command-keys "\\[eldoc-doc-buffer]")) - "...")))))))) - ((= available 1) - ;; Truncate "brutally." ; FIXME: use `eldoc-prefer-doc-buffer' too? - (with-current-buffer (eldoc-doc-buffer) - (truncate-string-to-width - (buffer-substring (goto-char (point-min)) (line-end-position 1)) width)))))) + ((and (numberp available) + (cl-plusp available)) + ;; Else, given a positive number of logical lines, we + ;; format the *eldoc* buffer, using as most of its + ;; contents as we know will fit. + (with-current-buffer (eldoc--format-doc-buffer docs) + (eldoc--echo-area-substring available))) + (t ;; this is the "truncate brutally" situation + (let ((string + (with-current-buffer (eldoc--format-doc-buffer docs) + (buffer-substring (goto-char (point-min)) + (line-end-position 1))))) + (if (> (length string) width) ; truncation to happen + (unless (eldoc--echo-area-prefer-doc-buffer-p t) + (truncate-string-to-width string width)) + (unless (eldoc--echo-area-prefer-doc-buffer-p nil) + string))))))) (when echo-area-message - (eldoc--message echo-area-message)))))) + (eldoc--message echo-area-message))))))) + +(defun eldoc-display-in-buffer (docs interactive) + "Display DOCS in a dedicated buffer. +If INTERACTIVE is t, also display the buffer." + (eldoc--format-doc-buffer docs) + (when interactive + (eldoc-doc-buffer))) (defun eldoc-documentation-default () "Show first doc string for item at point. @@ -709,19 +772,29 @@ have the following values: strings so far, as soon as possible." (funcall eldoc--make-callback method)) -(defun eldoc--invoke-strategy () +(defun eldoc--invoke-strategy (interactive) "Invoke `eldoc-documentation-strategy' function. +If INTERACTIVE is non-nil, the request came directly from a user +command, otherwise it came from ElDoc's idle +timer, `eldoc-timer'. + That function's job is to run the `eldoc-documentation-functions' special hook, using the `run-hook' family of functions. ElDoc's built-in strategy functions play along with the -`eldoc--make-callback' protocol, using it to produce callback to -feed to the functgions of `eldoc-documentation-functions'. - -Other third-party strategy functions do not use -`eldoc--make-callback'. They must find some alternate way to -produce callbacks to feed to `eldoc-documentation-function' and -should endeavour to display the docstrings eventually produced." +`eldoc--make-callback' protocol, using it to produce a callback +argument to feed the functions that the user places in +`eldoc-documentation-functions'. Whenever the strategy +determines it has information to display to the user, this +function passes responsibility to the functions in +`eldoc-display-functions'. + +Other third-party values of `eldoc-documentation-strategy' should +not use `eldoc--make-callback'. They must find some alternate +way to produce callbacks to feed to +`eldoc-documentation-function' and should endeavour to display +the docstrings eventually produced, using +`eldoc-display-functions'." (let* (;; How many callbacks have been created by the strategy ;; function and passed to elements of ;; `eldoc-documentation-functions'. @@ -739,11 +812,12 @@ should endeavour to display the docstrings eventually produced." (push (cons pos (cons string plist)) docs-registered))) (display-doc () - (eldoc--handle-docs - (mapcar #'cdr - (setq docs-registered - (sort docs-registered - (lambda (a b) (< (car a) (car b)))))))) + (run-hook-with-args + 'eldoc-display-functions (mapcar #'cdr + (setq docs-registered + (sort docs-registered + (lambda (a b) (< (car a) (car b)))))) + interactive)) (make-callback (method) (let ((pos (prog1 howmany (cl-incf howmany)))) @@ -786,22 +860,23 @@ should endeavour to display the docstrings eventually produced." (defun eldoc-print-current-symbol-info (&optional interactive) "Document thing at point." (interactive '(t)) - (let ((token (eldoc--request-state))) + (let (token) (cond (interactive - (eldoc--invoke-strategy)) - ((not (eldoc--request-docs-p token)) - ;; Erase the last message if we won't display a new one. - (when eldoc-last-message - (eldoc--message nil))) - (t + (eldoc--invoke-strategy t)) + ((not (equal (setq token (eldoc--request-state)) + eldoc--last-request-state)) (let ((non-essential t)) (setq eldoc--last-request-state token) ;; Only keep looking for the info as long as the user hasn't ;; requested our attention. This also locally disables ;; inhibit-quit. (while-no-input - (eldoc--invoke-strategy))))))) + (eldoc--invoke-strategy nil))))))) + +;; This section only affects ElDoc output to the echo area, as in +;; `eldoc-display-in-echo-area'. +;; ;; When point is in a sexp, the function args are not reprinted in the echo ;; area after every possible interactive command because some of them print ;; their own messages in the echo area; the eldoc functions would instantly @@ -833,7 +908,6 @@ should endeavour to display the docstrings eventually produced." (apply #'eldoc-remove-command (all-completions name eldoc-message-commands)))) - ;; Prime the command list. (eldoc-add-command-completions "back-to-indentation" diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index ebb27e8a62c..baa04f2c6af 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1305,7 +1305,8 @@ EXPECTEDP specifies whether the result was expected." "Pretty-print OBJECT, indenting it to the current column of point. Ensures a final newline is inserted." (let ((begin (point)) - (pp-escape-newlines nil)) + (pp-escape-newlines nil) + (print-escape-control-characters t)) (pp object (current-buffer)) (unless (bolp) (insert "\n")) (save-excursion diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 7ae6d53a21b..dd9cbd5d55a 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -25,25 +25,24 @@ ;;; Code: (require 'seq) +(require 'text-property-search) (eval-when-compile (require 'cl-lib)) (defgroup shortdoc nil "Short documentation." :group 'lisp) -(defface shortdoc-section +(defface shortdoc-separator '((((class color) (background dark)) - :inherit variable-pitch :background "#303030" :extend t) + :height 0.1 :background "#505050" :extend t) (((class color) (background light)) - :inherit variable-pitch :background "#f0f0f0" :extend t)) - "Face used for a section.") + :height 0.1 :background "#a0a0a0" :extend t) + (t :height 0.1 :inverse-video t :extend t)) + "Face used to separate sections.") -(defface shortdoc-example - '((((class color) (background dark)) - :background "#202020" :extend t) - (((class color) (background light)) - :background "#e8e8e8" :extend t)) - "Face used for examples.") +(defface shortdoc-section + '((t :inherit variable-pitch)) + "Face used for a section.") (defvar shortdoc--groups nil) @@ -78,6 +77,45 @@ There can be any number of :example/:result elements." shortdoc--groups)) (push (cons ',group ',functions) shortdoc--groups))) +(define-short-documentation-group alist + "Alist Basics" + (assoc + :eval (assoc 'foo '((foo . bar) (zot . baz)))) + (rassoc + :eval (rassoc 'bar '((foo . bar) (zot . baz)))) + (assq + :eval (assq 'foo '((foo . bar) (zot . baz)))) + (rassq + :eval (rassq 'bar '((foo . bar) (zot . baz)))) + (assoc-string + :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) + "Manipulating Alists" + (assoc-delete-all + :eval (assoc-delete-all "foo" '(("foo" . "bar") ("zot" . "baz")) #'equal)) + (assq-delete-all + :eval (assq-delete-all 'foo '((foo . bar) (zot . baz)))) + (rassq-delete-all + :eval (rassq-delete-all 'bar '((foo . bar) (zot . baz)))) + (alist-get + :eval (let ((foo '((bar . baz)))) + (setf (alist-get 'bar foo) 'zot) + foo)) + "Misc" + (assoc-default + :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) + (copy-alist + :eval (let* ((old '((foo . bar))) + (new (copy-alist old))) + (eq old new))) + ;; FIXME: Outputs "\.rose" for the symbol `.rose'. + ;; (let-alist + ;; :eval (let ((colors '((rose . red) + ;; (lily . white)))) + ;; (let-alist colors + ;; (if (eq .rose 'red) + ;; .lily)))) + ) + (define-short-documentation-group string "Making Strings" (make-string @@ -380,6 +418,37 @@ There can be any number of :example/:result elements." :no-eval (set-file-acl "/tmp/foo" "group::rxx") :eg-result t)) +(define-short-documentation-group hash-table + "Hash Table Basics" + (make-hash-table + :no-eval (make-hash-table) + :result-string "#s(hash-table ...)") + (puthash + :no-eval (puthash 'key "value" table)) + (gethash + :no-eval (gethash 'key table) + :eg-result "value") + (remhash + :no-eval (remhash 'key table) + :result nil) + (clrhash + :no-eval (clrhash table) + :result-string "#s(hash-table ...)") + (maphash + :no-eval (maphash (lambda (key value) (message value)) table) + :result nil) + "Other Hash Table Functions" + (hash-table-p + :eval (hash-table-p 123)) + (copy-hash-table + :no-eval (copy-hash-table table) + :result-string "#s(hash-table ...)") + (hash-table-count + :no-eval (hash-table-count table) + :eg-result 15) + (hash-table-size + :no-eval (hash-table-size table) + :eg-result 65)) (define-short-documentation-group list "Making Lists" @@ -557,15 +626,6 @@ There can be any number of :example/:result elements." :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) (string-match-p :eval (string-match-p "^[fo]+" "foobar")) - (match-string - :eval (and (string-match "^\\([fo]+\\)b" "foobar") - (match-string 0 "foobar"))) - (match-beginning - :no-eval (match-beginning 1) - :eg-result 0) - (match-end - :no-eval (match-end 1) - :eg-result 3) "Looking in Buffers" (re-search-forward :no-eval (re-search-forward "^foo$" nil t) @@ -576,6 +636,25 @@ There can be any number of :example/:result elements." (looking-at-p :no-eval (looking-at "f[0-9]") :eg-result t) + "Match Data" + (match-string + :eval (and (string-match "^\\([fo]+\\)b" "foobar") + (match-string 0 "foobar"))) + (match-beginning + :no-eval (match-beginning 1) + :eg-result 0) + (match-end + :no-eval (match-end 1) + :eg-result 3) + (save-match-data + :no-eval (save-match-data ...)) + "Replacing Match" + (replace-match + :no-eval (replace-match "new") + :eg-result nil) + (match-substitute-replacement + :no-eval (match-substitute-replacement "new") + :eg-result "new") "Utilities" (regexp-quote :eval (regexp-quote "foo.*bar")) @@ -584,7 +663,28 @@ There can be any number of :example/:result elements." (regexp-opt-depth :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) (regexp-opt-charset - :eval (regexp-opt-charset '(?a ?b ?c ?d ?e)))) + :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) + "The `rx' Structured Regexp Notation" + (rx + :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) + (rx-to-string + :eval (rx-to-string '(| "foo" "bar"))) + (rx-define + :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) + (rx haskell-comment))" + :result "--.*") + (rx-let + :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) + (number (1+ digit)) + (numbers (comma-separated number))) + (rx \"(\" numbers \")\"))" + :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") + (rx-let-eval + :eval "(rx-let-eval + '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) + (rx-to-string + '(ponder (or \"flowers\" \"cars\" \"socks\"))))" + :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) (define-short-documentation-group sequence "Sequence Predicates" @@ -963,19 +1063,27 @@ There can be any number of :example/:result elements." (unless (assq group shortdoc--groups) (error "No such documentation group %s" group)) (pop-to-buffer (format "*Shortdoc %s*" group)) - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t) + (prev nil)) (erase-buffer) - (special-mode) + (shortdoc-mode) (button-mode) (mapc (lambda (data) (cond ((stringp data) + (setq prev nil) + (unless (bobp) + (insert "\n")) (insert (propertize - (concat data "\n\n") - 'face '(variable-pitch (:height 1.3 :weight bold))))) + (concat (substitute-command-keys data) "\n\n") + 'face '(variable-pitch (:height 1.3 :weight bold)) + 'shortdoc-section t))) ;; There may be functions not yet defined in the data. ((fboundp (car data)) + (when prev + (insert (propertize "\n" 'face 'shortdoc-separator))) + (setq prev t) (shortdoc--display-function data)))) (cdr (assq group shortdoc--groups)))) (goto-char (point-min))) @@ -985,7 +1093,8 @@ There can be any number of :example/:result elements." (start-section (point)) arglist-start) ;; Function calling convention. - (insert "(") + (insert (propertize "(" + 'shortdoc-function t)) (if (plist-get data :no-manual) (insert (symbol-name function)) (insert-text-button @@ -1001,8 +1110,7 @@ There can be any number of :example/:result elements." (car (split-string (documentation function) "\n")))) (insert "\n") (add-face-text-property start-section (point) 'shortdoc-section t) - (let ((start (point)) - (print-escape-newlines t) + (let ((print-escape-newlines t) (double-arrow (if (char-displayable-p ?⇒) "⇒" "=>")) @@ -1057,9 +1165,7 @@ There can be any number of :example/:result elements." (:eg-result-string (insert " eg. " double-arrow " ") (princ value (current-buffer)) - (insert "\n")))) - (put-text-property start (point) 'face 'shortdoc-example)) - (insert "\n") + (insert "\n"))))) ;; Insert the arglist after doing the evals, in case that's pulled ;; in the function definition. (save-excursion @@ -1098,6 +1204,51 @@ Example: (setq slist (cdr slist))) (setcdr slist (cons elem (cdr slist)))))) +(defvar shortdoc-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "n") 'shortdoc-next) + (define-key map (kbd "p") 'shortdoc-previous) + (define-key map (kbd "C-c C-n") 'shortdoc-next-section) + (define-key map (kbd "C-c C-p") 'shortdoc-previous-section) + map) + "Keymap for `shortdoc-mode'") + +(define-derived-mode shortdoc-mode special-mode "shortdoc" + "Mode for shortdoc.") + +(defmacro shortdoc--goto-section (arg sym &optional reverse) + `(progn + (unless (natnump ,arg) + (setq ,arg 1)) + (while (< 0 ,arg) + (,(if reverse + 'text-property-search-backward + 'text-property-search-forward) + ,sym t) + (setq ,arg (1- ,arg))))) + +(defun shortdoc-next (&optional arg) + "Move cursor to next function." + (interactive "p") + (shortdoc--goto-section arg 'shortdoc-function)) + +(defun shortdoc-previous (&optional arg) + "Move cursor to previous function." + (interactive "p") + (shortdoc--goto-section arg 'shortdoc-function t) + (backward-char 1)) + +(defun shortdoc-next-section (&optional arg) + "Move cursor to next section." + (interactive "p") + (shortdoc--goto-section arg 'shortdoc-section)) + +(defun shortdoc-previous-section (&optional arg) + "Move cursor to previous section." + (interactive "p") + (shortdoc--goto-section arg 'shortdoc-section t) + (forward-line -2)) + (provide 'shortdoc) ;;; shortdoc.el ends here diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el index 61bd98d3cfe..d7dc7da7c18 100644 --- a/lisp/emacs-lisp/text-property-search.el +++ b/lisp/emacs-lisp/text-property-search.el @@ -34,11 +34,11 @@ "Search for the next region of text whose PROPERTY matches VALUE. If not found, return nil and don't move point. -If found, move point to end of the region and return a `prop-match' -object describing the match. To access the details of the match, -use `prop-match-beginning' and `prop-match-end' for the buffer -positions that limit the region, and `prop-match-value' for the -value of PROPERTY in the region. +If found, move point to the start of the region and return a +`prop-match' object describing the match. To access the details +of the match, use `prop-match-beginning' and `prop-match-end' for +the buffer positions that limit the region, and +`prop-match-value' for the value of PROPERTY in the region. PREDICATE is used to decide whether a value of PROPERTY should be considered as matching VALUE. @@ -125,7 +125,7 @@ that matches VALUE." "Search for the previous region of text whose PROPERTY matches VALUE. Like `text-property-search-forward', which see, but searches backward, -and if a matching region is found, moves point to its beginning." +and if a matching region is found, place point at its end." (interactive (list (let ((string (completing-read "Search for property: " obarray))) diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 00d09696d2a..4bda9acebf7 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -49,23 +49,25 @@ (let ((time (list (aref timer 1) (aref timer 2) (aref timer 3)))) - (format "%10.2f" - (float-time - (if (aref timer 7) - time - (time-subtract time nil))))) - 'help-echo "Time in sec till next invocation") + (format "%12s" + (format-seconds "%dd %hh %mm %z%,1ss" + (float-time + (if (aref timer 7) + time + (time-subtract time nil)))))) + 'help-echo "Time until next invocation") ;; Repeat. - ,(propertize - (let ((repeat (aref timer 4))) - (cond - ((numberp repeat) - (format "%8.1f" repeat)) - ((null repeat) - " -") - (t - (format "%8s" repeat)))) - 'help-echo "Symbol: repeat; number: repeat interval in sec") + ,(let ((repeat (aref timer 4))) + (cond + ((numberp repeat) + (propertize + (format "%12s" (format-seconds + "%dd %hh %mm %z%,1ss" repeat)) + 'help-echo "Repeat interval")) + ((null repeat) + (propertize " -" 'help-echo "Runs once")) + (t + (format "%12s" repeat)))) ;; Function. ,(propertize (let ((cl-print-compiled 'static) @@ -93,8 +95,8 @@ (setq-local revert-buffer-function #'list-timers) (setq tabulated-list-format '[("Idle" 6 timer-list--idle-predicate) - (" Next" 12 timer-list--next-predicate) - (" Repeat" 11 timer-list--repeat-predicate) + (" Next" 12 timer-list--next-predicate) + (" Repeat" 12 timer-list--repeat-predicate) ("Function" 10 timer-list--function-predicate)])) (defun timer-list--idle-predicate (A B) diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el index e7077140e54..c4db86a0db3 100644 --- a/lisp/emacs-lisp/unsafep.el +++ b/lisp/emacs-lisp/unsafep.el @@ -91,17 +91,41 @@ in the parse.") (put 'unsafep-vars 'risky-local-variable t) -;;Other safe functions +;; Other safe forms. +;; +;; A function, macro or special form may be put here only if all of +;; the following statements are true: +;; +;; * It is not already marked `pure' or `side-effect-free', or handled +;; explicitly by `unsafep'. +;; +;; * It is not inherently unsafe; eg, would allow the execution of +;; arbitrary code, interact with the file system, network or other +;; processes, or otherwise exfiltrate information from the running +;; Emacs process or manipulate the user's environment. +;; +;; * It does not have side-effects that can make other code behave in +;; unsafe and/or unexpected ways; eg, set variables, mutate data, or +;; change control flow. +;; Any side effect must be innocuous; altering the match data is +;; explicitly permitted. +;; +;; * It does not allow Emacs to behave deceptively to the user; eg, +;; display arbitrary messages. +;; +;; * It does not present a potentially large attack surface; eg, +;; play arbitrary audio files. + (dolist (x '(;;Special forms - and catch if or prog1 prog2 progn while unwind-protect + and if or prog1 prog2 progn while unwind-protect ;;Safe subrs that have some side-effects - ding error random signal sleep-for string-match throw + ding random sleep-for string-match ;;Defsubst functions from subr.el caar cadr cdar cddr ;;Macros from subr.el save-match-data unless when ;;Functions from subr.el that have side effects - split-string replace-regexp-in-string play-sound-file)) + split-string)) (put x 'safe-function t)) ;;;###autoload diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 9c3251e0e6f..7ca9dc1af1d 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -37,26 +37,56 @@ (require 'rect) -;; If non-nil, restrict current region to this rectangle. -;; Value is a vector [top bot left right corner ins virt select]. -;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r. -;; INS specifies whether to insert on left(nil) or right(t) side. -;; If VIRT is non-nil, virtual straight edges are enabled. -;; If SELECT is a regexp, only lines starting with that regexp are affected.") -(defvar cua--rectangle nil) +(defvar cua--rectangle nil + "If non-nil, restrict current region to this rectangle. +A cua-rectangle definition is a vector used for all actions in +`cua-rectangle-mark-mode', of the form: + + [top bot left right corner ins virt select] + +TOP is the upper-left corner point. + +BOTTOM is the point at the end of line after the the lower-right +corner point. + +LEFT and RIGHT are column numbers. + +CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r. + +INS specifies whether to insert on left(nil) or right(t) side. + +If VIRT is non-nil, virtual straight edges are enabled. + +If SELECT is a regexp, only lines starting with that regexp are +affected.") (make-variable-buffer-local 'cua--rectangle) -;; Most recent rectangle geometry. Note: car is buffer. -(defvar cua--last-rectangle nil) +(defvar cua--last-rectangle nil + "Most recent rectangle geometry. +A CONS cell, the car of which is the rectangle's buffer, and the +cdr of which is a cua-rectangle definition. +See `cua--rectangle'.") + -;; Rectangle restored by undo. -(defvar cua--restored-rectangle nil) +(defvar cua--restored-rectangle nil + "Rectangle restored by undo.") ;; Last rectangle copied/killed; nil if last kill was not a rectangle. +;; FIXME: The above seems to be incorrect: +;; + It seems to be the two most recent killed rectangles, and is not +;; reset upon either a `kill-region' or `kill-line' +;; + In the following example, the rectangle full of question marks +;; was killed prior to the rectangle with the string "active". +;; (#("???e\n??? \n???i\n???," 0 19 +;; (yank-handler +;; (rectangle--insert-for-yank +;; ("???e" "??? " "???i" "???,") +;; t))) +;; "active " "sert on" " straig" " lines ") (defvar cua--last-killed-rectangle nil) -;; List of overlays used to display current rectangle. -(defvar cua--rectangle-overlays nil) +(defvar cua--rectangle-overlays nil + "List of overlays used to display current rectangle.") (make-variable-buffer-local 'cua--rectangle-overlays) (put 'cua--rectangle-overlays 'permanent-local t) @@ -522,7 +552,7 @@ If command is repeated at same position, delete the rectangle." ;;; Operations on current rectangle (defun cua--tabify-start (start end) - ;; Return position where auto-tabify should start (or nil if not required). + "Return position where auto-tabify should start (or nil if not required)." (save-excursion (save-restriction (widen) @@ -538,15 +568,15 @@ If command is repeated at same position, delete the rectangle." start))))) (defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional fct post-fct) - ;; Call FCT for each line of region with 4 parameters: - ;; Region start, end, left-col, right-col - ;; Point is at start when FCT is called - ;; Call fct with (s,e) = whole lines if VISIBLE non-nil. - ;; Only call fct for visible lines if VISIBLE==t. - ;; Set undo boundary if UNDO is non-nil. - ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) - ;; Perform auto-tabify after operation if TABIFY is non-nil. - ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear. + "Call FCT for each line of region with 4 parameters: +Region start, end, left-col, right-col. +Point is at start when FCT is called. +Call fct with (s,e) = whole lines if VISIBLE non-nil. +Only call fct for visible lines if VISIBLE==t. +Set undo boundary if UNDO is non-nil. +Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) +Perform auto-tabify after operation if TABIFY is non-nil. +Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear." (let* ((inhibit-field-text-motion t) (start (cua--rectangle-top)) (end (cua--rectangle-bot)) @@ -683,9 +713,9 @@ If command is repeated at same position, delete the rectangle." (nreverse rect))) (defun cua--insert-rectangle (rect &optional below paste-column line-count) - ;; Insert rectangle as insert-rectangle, but don't set mark and exit with - ;; point at either next to top right or below bottom left corner - ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines. + "Insert rectangle as insert-rectangle, but don't set mark and exit with +point at either next to top right or below bottom left corner +Notice: In overwrite mode, the rectangle is inserted as separate text lines." (if (eq below 'auto) (setq below (and (bolp) (or (eolp) (eobp) (= (1+ (point)) (point-max)))))) diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1 index 90bd8bd09ee..fdf51954684 100644 --- a/lisp/erc/ChangeLog.1 +++ b/lisp/erc/ChangeLog.1 @@ -9116,7 +9116,7 @@ 2002-11-10 Alex Schroeder <alex@gnu.org> * TODO: - TODO: moved it to http://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO + TODO: moved it to https://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO * erc.el(with-erc-channel-buffer): Rudimentary doc string. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 1cf0bb49217..f99088d4c78 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -408,7 +408,7 @@ This string is processed using `format-time-string'." ;;; Flood-related ;; Most of this is courtesy of Jorgen Schaefer and Circe -;; (http://www.nongnu.org/circe) +;; (https://www.nongnu.org/circe) (defcustom erc-server-flood-margin 10 "A margin on how much excess data we send. diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index fd4cd6716d2..68aa6803278 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -439,7 +439,10 @@ Remove the DIRECTORY(ies), if they are empty.") (setq link (file-symlink-p source))) (progn (apply 'eshell-funcalln 'make-symbolic-link - link target args) + link target + ;; `make-symbolic-link' doesn't have + ;; KEEP-TIME; just OK-IF-ALREADY-EXISTS. + (list (car args))) (if (eq func 'rename-file) (if (and (file-directory-p source) (not (file-symlink-p source))) diff --git a/lisp/files.el b/lisp/files.el index e72f829a01c..67b3083df6a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6959,6 +6959,9 @@ If DIR's free space cannot be obtained, this function returns nil." s "+" "\\(" HH:MM "\\|" yyyy "\\)")) (western-comma (concat month s "+" dd "," s "+" yyyy)) + ;; This represents the date in strftime(3) format "%e-%b-%Y" + ;; (aka "%v"), as it is the default for many ls incarnations. + (DD-MMM-YYYY (concat dd "-" month "-" yyyy s HH:MM)) ;; Japanese MS-Windows ls-lisp has one-digit months, and ;; omits the Kanji characters after month and day-of-month. ;; On Mac OS X 10.3, the date format in East Asian locales is @@ -6986,7 +6989,8 @@ If DIR's free space cannot be obtained, this function returns nil." ;; This is not supported yet. (purecopy (concat "\\([0-9][BkKMGTPEZY]? " iso "\\|.*[0-9][BkKMGTPEZY]? " - "\\(" western "\\|" western-comma "\\|" east-asian "\\)" + "\\(" western "\\|" western-comma + "\\|" DD-MMM-YYYY "\\|" east-asian "\\)" "\\) +"))) "Regular expression to match up to the file name in a directory listing. The default value is designed to recognize dates and times diff --git a/lisp/forms.el b/lisp/forms.el index e9242ce4cb8..8974f99ef57 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -168,10 +168,9 @@ ;; modified (using text-property `read-only'). ;; Also, the read-write fields are shown using a ;; distinct face, if possible. -;; As of emacs 19.29, the `intangible' text property -;; is used to prevent moving into read-only fields. -;; This variable defaults to t if running Emacs 19 or -;; later with text properties. +;; The `intangible' text property is used to +;; prevent moving into read-only fields. +;; This variable defaults to t. ;; The default face to show read-write fields is ;; copied from face `region'. ;; @@ -363,8 +362,7 @@ This variable is for use by the filter routines only. The contents may NOT be modified.") (defcustom forms-use-text-properties t - "Non-nil means: use text properties. -Defaults to t if this Emacs is capable of handling text properties." + "Non-nil means to use text properties. " :group 'forms :type 'boolean) diff --git a/lisp/frame.el b/lisp/frame.el index 29ac862ccd4..772ba3d8c47 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1934,7 +1934,7 @@ for FRAME." ;; features change, it will be easy to find all the tests for such ;; capabilities by a simple text search. See more about the history ;; and the intent of these functions in -;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html +;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html ;; or in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35058#17. (declare-function msdos-mouse-p "dosfns.c") diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 2e9d85e39d8..1efc1d6f7d9 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2169,7 +2169,9 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (interactive) (save-excursion (when (article-goto-body) - (let ((inhibit-read-only t)) + (require 'ansi-color) + (let ((inhibit-read-only t) + (ansi-color-context-region nil)) (ansi-color-apply-on-region (point) (point-max)))))) (defun gnus-article-treat-unfold-headers () diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 807bd6a14af..ef811c65b86 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1013,6 +1013,12 @@ FILENAME exists and is Babyl format." (rmail-swap-buffers-maybe) (rmail-maybe-set-message-counters)) (widen) + (unless babyl + (goto-char (point-max)) + ;; Ensure we have a blank line before the next message. + (unless (bolp) + (insert "\n")) + (insert "\n")) (narrow-to-region (point-max) (point-max))) (insert-buffer-substring tmpbuf) (when msg diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 150f70e240f..0782778fd43 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2788,9 +2788,7 @@ Consider adding this function to `message-header-setup-hook'" ;; add URL (when (nth 1 message-openpgp-header) (when need-sep (insert "; ")) - (if (string-match-p ";") - (insert "url=\"" (nth 1 message-openpgp-header) "\"") - (insert "url=\"" (nth 1 message-openpgp-header) "\"")) + (insert "url=\"" (nth 1 message-openpgp-header) "\"") (setq need-sep t)) ;; add preference (when (nth 2 message-openpgp-header) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 0dc6c9ffae0..f0770fb6602 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -756,16 +756,15 @@ Show all docs for that symbol as either a variable, function or face." (help-do-xref pos #'describe-symbol (list sym)) (user-error "No symbol here")))) -(defun help-mode-revert-buffer (_ignore-auto noconfirm) - (when (or noconfirm (yes-or-no-p "Revert help buffer? ")) - (let ((pos (point)) - (item help-xref-stack-item) - ;; Pretend there is no current item to add to the history. - (help-xref-stack-item nil) - ;; Use the current buffer. - (help-xref-following t)) - (apply (car item) (cdr item)) - (goto-char pos)))) +(defun help-mode-revert-buffer (_ignore-auto _noconfirm) + (let ((pos (point)) + (item help-xref-stack-item) + ;; Pretend there is no current item to add to the history. + (help-xref-stack-item nil) + ;; Use the current buffer. + (help-xref-following t)) + (apply (car item) (cdr item)) + (goto-char pos))) (defun help-insert-string (string) "Insert STRING to the help buffer and install xref info for it. diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 23abb0d0a9e..a52b6283c3e 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -191,6 +191,7 @@ (kanbun #x319D) (han #x5B57) (yi #xA288) + (javanese #xA980) (cham #xAA00) (tai-viet #xAA80) (hangul #xAC00) @@ -723,6 +724,7 @@ symbol braille yi + javanese tai-viet aegean-number ancient-greek-number diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index c84f0a49901..42dd19842c8 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -39,7 +39,7 @@ ;; Society of Japan/Information Technology Standards Commission of ;; Japan (IPSJ/ITSCJ) at https://www.itscj.ipsj.or.jp/itscj_english/. ;; Standards docs equivalent to iso-2022 and iso-8859 are at -;; http://www.ecma.ch/. +;; https://www.ecma.ch/. ;; FWIW, http://www.microsoft.com/globaldev/ lists the following for ;; MS Windows, which are presumably the only charsets we really need diff --git a/lisp/isearch.el b/lisp/isearch.el index 0879f948cff..c3d5ff2d313 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -54,7 +54,6 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(declare-function tmm-menubar-keymap "tmm.el") ;; Some additional options and constants. @@ -505,7 +504,7 @@ This is like `describe-bindings', but displays only Isearch keys." (require 'tmm) (run-hooks 'menu-bar-update-hook) (let ((command nil)) - (let ((menu-bar (tmm-menubar-keymap))) + (let ((menu-bar (menu-bar-keymap))) (with-isearch-suspended (setq command (let ((isearch-mode t)) ; Show bindings from ; `isearch-mode-map' in diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index ffbc253a976..7de6baeb00a 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -26,7 +26,7 @@ ;;; Commentary: ;; This library implements the JSONRPC 2.0 specification as described -;; in http://www.jsonrpc.org/. As the name suggests, JSONRPC is a +;; in https://www.jsonrpc.org/. As the name suggests, JSONRPC is a ;; generic Remote Procedure Call protocol designed around JSON ;; objects. To learn how to write JSONRPC programs with this library, ;; see Info node `(elisp)JSONRPC'." diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el index 1888c8f86a2..d689e87d785 100644 --- a/lisp/language/burmese.el +++ b/lisp/language/burmese.el @@ -1,4 +1,4 @@ -;;; burmese.el --- support for Burmese -*- coding: utf-8 -*- +;;; burmese.el --- support for Burmese -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/cham.el b/lisp/language/cham.el index 4749f2e8db4..eef6d6f8f9f 100644 --- a/lisp/language/cham.el +++ b/lisp/language/cham.el @@ -1,4 +1,4 @@ -;;; cham.el --- support for Cham -*- coding: utf-8 -*- +;;; cham.el --- support for Cham -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011, 2012 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/czech.el b/lisp/language/czech.el index b3cc152d25e..e6923426b52 100644 --- a/lisp/language/czech.el +++ b/lisp/language/czech.el @@ -1,4 +1,4 @@ -;;; czech.el --- support for Czech -*- coding: utf-8 -*- +;;; czech.el --- support for Czech -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el index 3e3c1df31a0..53c994bd76f 100644 --- a/lisp/language/georgian.el +++ b/lisp/language/georgian.el @@ -1,4 +1,4 @@ -;;; georgian.el --- language support for Georgian +;;; georgian.el --- language support for Georgian -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/greek.el b/lisp/language/greek.el index 2fec52637be..15ae5f42f94 100644 --- a/lisp/language/greek.el +++ b/lisp/language/greek.el @@ -1,4 +1,4 @@ -;;; greek.el --- support for Greek +;;; greek.el --- support for Greek -*- lexical-binding: t -*- ;; Copyright (C) 2002, 2013-2020 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el index 4a070321961..37173c9fb95 100644 --- a/lisp/language/khmer.el +++ b/lisp/language/khmer.el @@ -1,4 +1,4 @@ -;;; khmer.el --- support for Khmer -*- coding: utf-8 -*- +;;; khmer.el --- support for Khmer -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index 3f45f70c45e..089b79c5208 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -149,11 +149,50 @@ thin (i.e. 1-dot width) space." ;; Hieroglyphs in "quadrats", as directed by the format controls, ;; which specify how the hieroglyphs should be joined horizontally and ;; vertically. -(set-char-table-range - composition-function-table - '(#x13000 . #x1343F) - (list (vector "[\U00013000-\U0001343F]+" - 0 'compose-gstring-for-graphic))) +(defun egyptian-shape-grouping (gstring direction) + (if (= (lgstring-char gstring 0) #x13437) + (let ((nchars (lgstring-char-len gstring)) + (i 1) + (nesting 1) + ch) + ;; Find where this group ends. + (while (and (< i nchars) (> nesting 0)) + (setq ch (lgstring-char gstring i)) + (cond + ((= ch #x13437) + (setq nesting (1+ nesting))) + ((= ch #x13438) + (setq nesting (1- nesting)))) + (setq i (1+ i))) + (when (zerop nesting) + ;; Make a new gstring from the characters that constitute a + ;; complete nested group. + (let ((new-header (make-vector (1+ i) nil)) + (new-gstring (make-vector (+ i 2) nil))) + (aset new-header 0 (lgstring-font gstring)) + (dotimes (j i) + (aset new-header (1+ j) (lgstring-char gstring j)) + (lgstring-set-glyph new-gstring j (lgstring-glyph gstring j))) + (lgstring-set-header new-gstring new-header) + (font-shape-gstring new-gstring direction)))))) + +(let ((hieroglyph "[\U00013000-\U0001342F]")) + ;; HORIZONTAL/VERTICAL JOINER and INSERT AT.../OVERLAY controls + (set-char-table-range + composition-function-table + '(#x13430 . #x13436) + (list (vector (concat hieroglyph "[\U00013430-\U00013436]" hieroglyph) + ;; We use font-shape-gstring so that, if the font + ;; doesn't support these controls, the glyphs are + ;; displayed individually, and not as a single + ;; grapheme cluster. + 1 'font-shape-gstring))) + ;; Grouping controls + (set-char-table-range + composition-function-table + #x13437 + (list (vector "\U00013437[\U00013000-\U0001343F]+" + 0 'egyptian-shape-grouping)))) (provide 'misc-lang) diff --git a/lisp/language/romanian.el b/lisp/language/romanian.el index 0cd1d61de0f..9f1c67765e1 100644 --- a/lisp/language/romanian.el +++ b/lisp/language/romanian.el @@ -1,4 +1,4 @@ -;;; romanian.el --- support for Romanian -*- coding: utf-8 -*- +;;; romanian.el --- support for Romanian -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el index efd8aacc5ac..90fc41c1c41 100644 --- a/lisp/language/sinhala.el +++ b/lisp/language/sinhala.el @@ -1,4 +1,4 @@ -;;; sinhala.el --- support for Sinhala -*- coding: utf-8 -*- +;;; sinhala.el --- support for Sinhala -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/slovak.el b/lisp/language/slovak.el index bc70a05ad08..c42a872574d 100644 --- a/lisp/language/slovak.el +++ b/lisp/language/slovak.el @@ -1,4 +1,4 @@ -;;; slovak.el --- support for Slovak -*- coding: utf-8 -*- +;;; slovak.el --- support for Slovak -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el index 22295f39e52..039e478b162 100644 --- a/lisp/language/tai-viet.el +++ b/lisp/language/tai-viet.el @@ -1,4 +1,4 @@ -;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8 -*- +;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2007-2020 Free Software Foundation, Inc. ;; Copyright (C) 2007, 2008, 2009, 2010, 2011 diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el index cb282db0762..c1cef962865 100644 --- a/lisp/language/vietnamese.el +++ b/lisp/language/vietnamese.el @@ -1,4 +1,4 @@ -;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; -*- +;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 8851522bbdb..e2646209313 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -836,6 +836,9 @@ Return nil if no time switch found." ((memq ?t switches) 5) ; last modtime ((memq ?u switches) 4))) ; last access +(defvar ls-lisp--time-locale nil + "Locale to be used for formatting file times.") + (defun ls-lisp-format-time (file-attr time-index) "Format time for file with attributes FILE-ATTR according to TIME-INDEX. Use the same method as ls to decide whether to show time-of-day or year, @@ -851,11 +854,13 @@ All ls time options, namely c, t and u, are handled." (condition-case nil ;; Use traditional time format in the C or POSIX locale, ;; ISO-style time format otherwise, so columns line up. - (let ((locale system-time-locale)) + (let ((locale (or system-time-locale ls-lisp--time-locale))) (if (not locale) (let ((vars '("LC_ALL" "LC_TIME" "LANG"))) (while (and vars (not (setq locale (getenv (car vars))))) - (setq vars (cdr vars))))) + (setq vars (cdr vars))) + ;; Cache the locale for next calls. + (setq ls-lisp--time-locale (or locale "C")))) (if (member locale '("C" "POSIX")) (setq locale nil)) (format-time-string diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index 431c681be01..035bb32fa12 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -317,7 +317,7 @@ If HEADER-ONLY is non-nil only decode header and return filename." (binhex-decode-region-external start end) (binhex-decode-region-internal start end))) -(define-obsolete-function-alias 'binhex-char-int #'identity) +(define-obsolete-function-alias 'binhex-char-int #'identity "28.1") (provide 'binhex) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index e48c25436ee..d524b26f1b9 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -519,8 +519,8 @@ Message buffer where you can explain more about the patch." (add-hook 'message-send-hook (lambda () (message-goto-body) - (insert "Tags: patch\nthanks\n\n")) - t) + (insert "Tags: patch\n\n")) + nil t) (message-add-action (lambda () ;; Bury the help buffer (if it's shown). diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 0d7193c1be0..98782efb4b6 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -1911,7 +1911,7 @@ see the variable feedmail-prompt-before-queue-user-alist. (and (stringp feedmail-prompt-before-queue-help-supplement) (princ feedmail-prompt-before-queue-help-supplement)) (with-current-buffer standard-output - (if (fboundp 'help-mode) (help-mode))))) + (help-mode)))) (defun feedmail-message-action-scroll-up () @@ -1972,13 +1972,9 @@ backup file names and the like)." (list-of-possible-fqms)) (if (and (> q-cnt 0) feedmail-queue-runner-confirm-global) (setq do-the-run - (if (fboundp 'y-or-n-p-with-timeout) - (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? " - d-cnt d-oth q-cnt q-oth) - 5 nil) - (y-or-n-p (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? " - d-cnt d-oth q-cnt q-oth)) - ))) + (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? " + d-cnt d-oth q-cnt q-oth) + 5 nil))) (if (not do-the-run) (setq messages-skipped q-cnt) (save-window-excursion @@ -1997,15 +1993,10 @@ backup file names and the like)." (if (and already-buffer (buffer-modified-p already-buffer)) (save-window-excursion (display-buffer (set-buffer already-buffer)) - (if (fboundp 'y-or-n-p-with-timeout) - ;; make a guess that the user just forgot to save - (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t) - (save-buffer)) - (if (y-or-n-p (format "FQM: Visiting %s; save before send? " blobby)) - (save-buffer)) - ))) - - (set-buffer blobby-buffer) + ;; make a guess that the user just forgot to save + (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t) + (save-buffer)))) + (set-buffer blobby-buffer) (setq buffer-offer-save nil) (buffer-disable-undo blobby-buffer) (insert-file-contents-literally maybe-file) @@ -2158,17 +2149,8 @@ you can set `feedmail-queue-reminder-alist' to nil." (setq answer (cons '^ helper)) (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y)) (setq user-sez d-char)) - ;; these char-to-int things are because of some - ;; incomprehensible difference between the two in - ;; byte-compiled stuff between Emacs and XEmacs - ;; (well, I'm sure someone could comprehend it, - ;; but I say 'uncle') - (setq answer (or (assoc user-sez user-alist) - (and (fboundp 'char-to-int) - (assoc (char-to-int user-sez) user-alist)) - (assoc user-sez standard-alist) - (and (fboundp 'char-to-int) - (assoc (char-to-int user-sez) standard-alist)))) + (setq answer (or (assoc user-sez user-alist) + (assoc user-sez standard-alist))) (if (or (null answer) (null (cdr answer))) (progn (beep) @@ -2414,7 +2396,7 @@ mapped to mostly alphanumerics for safety." ;; mail-aliases nil = mail-abbrevs.el (feedmail-say-debug "expanding mail aliases") (if (or feedmail-force-expand-mail-aliases - (and (fboundp 'expand-mail-aliases) mail-aliases)) + mail-aliases) (expand-mail-aliases (point-min) eoh-marker)) ;; Make it pretty. @@ -3130,8 +3112,7 @@ been weeded out." ;; won't delete the newly created frame upon exit! (save-window-excursion (switch-to-buffer buffer) - (if (and (fboundp 'y-or-n-p-with-timeout) - (numberp feedmail-confirm-outgoing-timeout)) + (if (numberp feedmail-confirm-outgoing-timeout) (y-or-n-p-with-timeout "FQM: Send this email? " (abs feedmail-confirm-outgoing-timeout) diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el index 12cffd9bc4b..a2705d659a4 100644 --- a/lisp/mail/hashcash.el +++ b/lisp/mail/hashcash.el @@ -116,15 +116,6 @@ For example, you may want to set this to (\"-Z2\") to reduce header length." (require 'mail-utils) -(eval-and-compile - (if (fboundp 'point-at-bol) - (defalias 'hashcash-point-at-bol 'point-at-bol) - (defalias 'hashcash-point-at-bol 'line-beginning-position)) - - (if (fboundp 'point-at-eol) - (defalias 'hashcash-point-at-eol 'point-at-eol) - (defalias 'hashcash-point-at-eol 'line-end-position))) - (defun hashcash-strip-quoted-names (addr) (setq addr (mail-strip-quoted-names addr)) (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr)) @@ -141,8 +132,8 @@ For example, you may want to set this to (\"-Z2\") to reduce header length." (let ((token "")) (cl-loop (setq token - (concat token (buffer-substring (point) (hashcash-point-at-eol)))) - (goto-char (hashcash-point-at-eol)) + (concat token (buffer-substring (point) (line-end-position)))) + (goto-char (line-end-position)) (forward-char 1) (unless (looking-at "[ \t]") (cl-return token)) (while (looking-at "[ \t]") (forward-char 1)))))) @@ -374,6 +365,9 @@ Prefix arg sets default accept amount temporarily." (message "Payment valid")) ok)))) +(define-obsolete-function-alias 'hashcash-point-at-bol #'line-beginning-position "28.1") +(define-obsolete-function-alias 'hashcash-point-at-eol #'line-end-position "28.1") + (provide 'hashcash) ;;; hashcash.el ends here diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index c296f29f9ea..49dfd2ee874 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1851,7 +1851,7 @@ place. It affects how `mail-extract-address-components' works." ;; Updated by the RIPE Network Coordination Centre. ;; ;; Source: ISO 3166 Maintenance Agency -;; http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt +;; https://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt ;; https://www.iana.org/domain-names.htm ;; https://www.iana.org/cctld/cctld-whois.htm ;; Latest change: 2007/11/15 diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el index 894313633da..e0274c8a11b 100644 --- a/lisp/mail/mail-parse.el +++ b/lisp/mail/mail-parse.el @@ -1,4 +1,4 @@ -;;; mail-parse.el --- Interface functions for parsing mail +;;; mail-parse.el --- Interface functions for parsing mail -*- lexical-binding: t -*- ;; Copyright (C) 1998-2020 Free Software Foundation, Inc. diff --git a/lisp/mail/mail-prsvr.el b/lisp/mail/mail-prsvr.el index 9023c00a66e..7c67c49b0b4 100644 --- a/lisp/mail/mail-prsvr.el +++ b/lisp/mail/mail-prsvr.el @@ -1,4 +1,4 @@ -;;; mail-prsvr.el --- Interface variables for parsing mail +;;; mail-prsvr.el --- Interface variables for parsing mail -*- lexical-binding: t -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index cc55451902a..521659b7eb6 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -931,8 +931,8 @@ a negative argument means to delete and move backward." (not (and backward (bobp)))) (rmail-summary-goto-msg) (with-current-buffer rmail-buffer - (rmail-delete-message) - (setq del-msg rmail-current-message)) + (setq del-msg rmail-current-message) + (rmail-delete-message)) (rmail-summary-mark-deleted del-msg) (while (and (not (if backward (bobp) (eobp))) (save-excursion (beginning-of-line) diff --git a/lisp/md4.el b/lisp/md4.el index 029a125b8ae..11c91307afc 100644 --- a/lisp/md4.el +++ b/lisp/md4.el @@ -22,6 +22,16 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;; Commentary: + +;; The MD4 Message-Digest Algorithm. +;; +;; The security of the MD4 hashing algorithm is very poor to +;; non-existent. It was declared obsolete by RFC 6150 in 2011: +;; https://tools.ietf.org/html/rfc6150 +;; +;; You probably want to use `secure-hash' instead. + ;;; Code: ;;; @@ -33,7 +43,12 @@ (defun md4 (in n) "Return the MD4 hash for a string IN of length N bytes. The returned hash is 16 bytes long. N is required to handle -strings containing the character 0." +strings containing the character 0. + +The security of the MD4 hashing algorithm is very poor to +non-existent. It was declared obsolete by RFC 6150 in 2011. + +You probably want to use `secure-hash' instead." (let (m (b (cons 0 (* n 8))) (i 0) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index da4ad9799bd..c6ced689a67 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1570,8 +1570,8 @@ mail status in mode line")) (bindings--define-key menu [cua-emulation-mode] (menu-bar-make-mm-toggle cua-mode - "Shift movement mark region (CUA)" - "Use shifted movement keys to set and extend the region" + "CUA Mode (without C-x/C-c/C-v)" + "Enable CUA Mode without rebinding C-x/C-c/C-v keys" (:visible (and (boundp 'cua-enable-cua-keys) (not cua-enable-cua-keys))))) @@ -2088,6 +2088,8 @@ key, a click, or a menu-item")) (bindings--define-key global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu)) +(define-key global-map [menu-bar mouse-1] 'menu-bar-open-mouse) + (defun menu-bar-menu-frame-live-and-visible-p () "Return non-nil if the menu frame is alive and visible. The menu frame is the frame for which we are updating the menu." @@ -2663,6 +2665,92 @@ If FRAME is nil or not given, use the selected frame." (global-set-key [f10] 'menu-bar-open) +(defun menu-bar-open-mouse (event) + "Open the menu bar for the menu item clicked on by the mouse. +EVENT should be a mouse down or click event. + +Also see `menu-bar-open', which this calls. +This command is to be used when you click the mouse in the menubar." + (interactive "e") + ;; This only should be bound to clicks on the menu-bar, outside of + ;; any window. + (let ((window (posn-window (event-start event)))) + (when window + (error "Event is inside window %s" window))) + + (let* ((x-position (car (posn-x-y (event-start event)))) + (menu-bar-item-cons (menu-bar-item-at-x x-position))) + (menu-bar-open nil + (if menu-bar-item-cons + (cdr menu-bar-item-cons) + 0)))) + +(defun menu-bar-keymap () + "Return the current menu-bar keymap. + +The ordering of the return value respects `menu-bar-final-items'." + (let ((menu-bar '()) + (menu-end '())) + (map-keymap + (lambda (key binding) + (let ((pos (seq-position menu-bar-final-items key)) + (menu-item (cons key binding))) + (if pos + ;; If KEY is the name of an item that we want to put + ;; last, store it separately with explicit ordering for + ;; sorting. + (push (cons pos menu-item) menu-end) + (push menu-item menu-bar)))) + (lookup-key (menu-bar-current-active-maps) [menu-bar])) + `(keymap ,@(nreverse menu-bar) + ,@(mapcar #'cdr (sort menu-end + (lambda (a b) + (< (car a) (car b)))))))) + +(defun menu-bar-current-active-maps () + "Return the current active maps in the order the menu bar displays them. +This value does not take into account `menu-bar-final-items' as that applies +per-item." + ;; current-active-maps returns maps in the order local then + ;; global. The menu bar displays items in the opposite order. + (cons 'keymap (nreverse (current-active-maps)))) + +(defun menu-bar-item-at-x (x-position) + "Return a cons of the form (KEY . X) for a menu item. +The returned X is the left X coordinate for that menu item. + +X-POSITION is the X coordinate being queried. If nothing is clicked on, +returns nil." + (let ((column 0) + (menu-bar (menu-bar-keymap)) + prev-key + prev-column + found) + (catch 'done + (map-keymap + (lambda (key binding) + (when (> column x-position) + (setq found t) + (throw 'done nil)) + (setq prev-key key) + (pcase binding + ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item. + `(menu-item ,name ,_cmd ;Extended menu item. + . ,(and props + (guard (let ((visible + (plist-get props :visible))) + (or (null visible) + (eval visible))))))) + (setq prev-column column + column (+ column (length name) 1))))) + menu-bar) + ;; Check the last menu item. + (when (> column x-position) + (setq found t))) + (if found + (cons prev-key prev-column) + nil))) + (defun buffer-menu-open () "Start key navigation of the buffer menu. This is the keyboard interface to \\[mouse-buffer-menu]." @@ -2682,6 +2770,16 @@ This is the keyboard interface to \\[mouse-buffer-menu]." (menu-bar-buffer-vector item))))) km)) +(defun menu-bar-define-mouse-key (map key def) + "Like `define-key', but adds all possible prefixes for the mouse." + (define-key map (vector key) def) + (mapc (lambda (prefix) (define-key map (vector prefix key) def)) + ;; This list only needs to contain special window areas that + ;; are rendered in TTYs. No need for *-scroll-bar, *-fringe, + ;; or *-divider. + '(tab-line header-line menu-bar tab-bar mode-line vertical-line + left-margin right-margin))) + (defvar tty-menu-navigation-map (let ((map (make-sparse-keymap))) ;; The next line is disabled because it breaks interpretation of @@ -2716,39 +2814,33 @@ This is the keyboard interface to \\[mouse-buffer-menu]." (define-key map [?\C-j] 'tty-menu-select) (define-key map [return] 'tty-menu-select) (define-key map [linefeed] 'tty-menu-select) - (define-key map [mouse-1] 'tty-menu-select) - (define-key map [drag-mouse-1] 'tty-menu-select) - (define-key map [mouse-2] 'tty-menu-select) - (define-key map [drag-mouse-2] 'tty-menu-select) - (define-key map [mouse-3] 'tty-menu-select) - (define-key map [drag-mouse-3] 'tty-menu-select) - (define-key map [wheel-down] 'tty-menu-next-item) - (define-key map [wheel-up] 'tty-menu-prev-item) - (define-key map [wheel-left] 'tty-menu-prev-menu) - (define-key map [wheel-right] 'tty-menu-next-menu) - ;; The following 4 bindings are for those whose text-mode mouse + (menu-bar-define-mouse-key map 'mouse-1 'tty-menu-select) + (menu-bar-define-mouse-key map 'drag-mouse-1 'tty-menu-select) + (menu-bar-define-mouse-key map 'mouse-2 'tty-menu-select) + (menu-bar-define-mouse-key map 'drag-mouse-2 'tty-menu-select) + (menu-bar-define-mouse-key map 'mouse-3 'tty-menu-select) + (menu-bar-define-mouse-key map 'drag-mouse-3 'tty-menu-select) + (menu-bar-define-mouse-key map 'wheel-down 'tty-menu-next-item) + (menu-bar-define-mouse-key map 'wheel-up 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'wheel-left 'tty-menu-prev-menu) + (menu-bar-define-mouse-key map 'wheel-right 'tty-menu-next-menu) + ;; The following 6 bindings are for those whose text-mode mouse ;; lack the wheel. - (define-key map [S-mouse-1] 'tty-menu-next-item) - (define-key map [S-drag-mouse-1] 'tty-menu-next-item) - (define-key map [S-mouse-2] 'tty-menu-prev-item) - (define-key map [S-drag-mouse-2] 'tty-menu-prev-item) - (define-key map [S-mouse-3] 'tty-menu-prev-item) - (define-key map [S-drag-mouse-3] 'tty-menu-prev-item) - (define-key map [header-line mouse-1] 'tty-menu-select) - (define-key map [header-line drag-mouse-1] 'tty-menu-select) + (menu-bar-define-mouse-key map 'S-mouse-1 'tty-menu-next-item) + (menu-bar-define-mouse-key map 'S-drag-mouse-1 'tty-menu-next-item) + (menu-bar-define-mouse-key map 'S-mouse-2 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'S-drag-mouse-2 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'S-mouse-3 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'S-drag-mouse-3 'tty-menu-prev-item) ;; The down-mouse events must be bound to tty-menu-ignore, so that ;; only releasing the mouse button pops up the menu. - (define-key map [mode-line down-mouse-1] 'tty-menu-ignore) - (define-key map [mode-line down-mouse-2] 'tty-menu-ignore) - (define-key map [mode-line down-mouse-3] 'tty-menu-ignore) - (define-key map [mode-line C-down-mouse-1] 'tty-menu-ignore) - (define-key map [mode-line C-down-mouse-2] 'tty-menu-ignore) - (define-key map [mode-line C-down-mouse-3] 'tty-menu-ignore) - (define-key map [down-mouse-1] 'tty-menu-ignore) - (define-key map [C-down-mouse-1] 'tty-menu-ignore) - (define-key map [C-down-mouse-2] 'tty-menu-ignore) - (define-key map [C-down-mouse-3] 'tty-menu-ignore) - (define-key map [mouse-movement] 'tty-menu-mouse-movement) + (menu-bar-define-mouse-key map 'down-mouse-1 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'down-mouse-2 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'down-mouse-3 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'C-down-mouse-1 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'C-down-mouse-2 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'C-down-mouse-3 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'mouse-movement 'tty-menu-mouse-movement) map) "Keymap used while processing TTY menus.") diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 3c07d426b7d..7536f949e76 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -219,8 +219,7 @@ Sets the current buffer to the show buffer." (erase-buffer) ;; Changing contents, so this hook needs to be reinitialized. ;; pgp.el uses this. - (if (boundp 'write-contents-hooks) ;Emacs 19 - (kill-local-variable 'write-contents-hooks)) + (kill-local-variable 'write-contents-functions) (font-lock-mode -1) (mh-show-mode) (if formfile diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index 43a589aeca2..e6ee87b8411 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -29,7 +29,7 @@ ;; https://www.jwz.org/doc/threading.html ;; It also begins to implement the threading section of the IMAP - ;; SORT and THREAD Extensions RFC at: -;; http://tools.ietf.org/html/rfc5256 +;; https://tools.ietf.org/html/rfc5256 ;; The implementation lacks the reference and subject canonicalization ;; of the RFC. diff --git a/lisp/misc.el b/lisp/misc.el index be191c50d2f..03395781a51 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -127,7 +127,7 @@ upper atmosphere. These cause momentary pockets of higher-pressure air to form, which act as lenses that deflect incoming cosmic rays, focusing them to strike the drive platter and flip the desired bit. You can type `M-x butterfly C-M-c' to run it. This is a permuted -variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." +variation of `C-x M-c M-butterfly' from url `https://xkcd.com/378/'." (interactive) (if (yes-or-no-p "Do you really want to unleash the powers of the butterfly? ") (progn @@ -139,7 +139,7 @@ variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." (sit-for (* 5 (/ (abs (random)) (float most-positive-fixnum)))) (message "Successfully flipped one bit!")) (message "Well, then go to xkcd.com!") - (browse-url "http://xkcd.com/378/"))) + (browse-url "https://xkcd.com/378/"))) ;; A command to list dynamically loaded libraries. This useful in ;; environments where dynamic-library-alist is used, i.e., Windows diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index bb2420e1f49..8b40808005b 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1942,35 +1942,38 @@ It will be registered for all objects created by `dbus-register-service'." ;; Check for object path wildcard interfaces. (maphash (lambda (key val) - (when (and (equal (butlast key 2) (list :property bus)) - (null (nth 2 (car-safe val)))) - (push (nth 2 key) interfaces))) + (when (equal (butlast key 2) (list :property bus)) + (dolist (item val) + (unless (nth 2 item) ; Path. + (push (nth 2 key) interfaces))))) dbus-registered-objects-table) ;; Check all registered object paths. (maphash (lambda (key val) - (let ((object (or (nth 2 (car-safe val)) ""))) - (when (and (equal (butlast key 2) (list :property bus)) - (string-prefix-p path object)) - (dolist (interface (cons (nth 2 key) interfaces)) - (unless (assoc object result) - (push (list object) result)) - (unless (assoc interface (cdr (assoc object result))) - (setcdr - (assoc object result) - (append - (list (cons - interface - ;; We simulate "org.freedesktop.DBus.Properties.GetAll" - ;; by using an appropriate D-Bus event. - (let ((last-input-event - (append - (butlast last-input-event 4) - (list object dbus-interface-properties - "GetAll" #'dbus-property-handler)))) - (dbus-property-handler interface)))) - (cdr (assoc object result))))))))) + (when (equal (butlast key 2) (list :property bus)) + (dolist (item val) + (let ((object (or (nth 2 item) ""))) ; Path. + (when (string-prefix-p path object) + (dolist (interface (cons (nth 2 key) (delete-dups interfaces))) + (unless (assoc object result) + (push (list object) result)) + (unless (assoc interface (cdr (assoc object result))) + (setcdr + (assoc object result) + (append + (list (cons + interface + ;; We simulate + ;; "org.freedesktop.DBus.Properties.GetAll" + ;; by using an appropriate D-Bus event. + (let ((last-input-event + (append + (butlast last-input-event 4) + (list object dbus-interface-properties + "GetAll" #'dbus-property-handler)))) + (dbus-property-handler interface)))) + (cdr (assoc object result))))))))))) dbus-registered-objects-table) ;; Return the result, or an empty array. diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index bc939e0d396..bb1474b8b5b 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -1,4 +1,4 @@ -;;; eudc-vars.el --- Emacs Unified Directory Client +;;; eudc-vars.el --- Emacs Unified Directory Client -*- lexical-binding: t -*- ;; Copyright (C) 1998-2020 Free Software Foundation, Inc. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 53835bb5440..ebc75e0e8a7 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1190,6 +1190,7 @@ just re-display the HTML already fetched." (define-key map [(control e)] 'eww-end-of-text) (define-key map [?\t] 'shr-next-link) (define-key map [?\M-\t] 'shr-previous-link) + (define-key map [backtab] 'shr-previous-link) map)) (defvar eww-textarea-map @@ -1199,6 +1200,7 @@ just re-display the HTML already fetched." (define-key map [(control c) (control c)] 'eww-submit) (define-key map [?\t] 'shr-next-link) (define-key map [?\M-\t] 'shr-previous-link) + (define-key map [backtab] 'shr-previous-link) map)) (defvar eww-select-map diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el index bfacc73a2a4..944cc6cef6c 100644 --- a/lisp/net/hmac-def.el +++ b/lisp/net/hmac-def.el @@ -1,4 +1,4 @@ -;;; hmac-def.el --- A macro for defining HMAC functions. +;;; hmac-def.el --- A macro for defining HMAC functions. -*- lexical-binding: t -*- ;; Copyright (C) 1999, 2001, 2007-2020 Free Software Foundation, Inc. diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 700653250fb..5639d52f815 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -29,7 +29,7 @@ ;; `ldapsearch' to actually perform the searches. That program can be ;; found in all LDAP developer kits such as: ;; - UM-LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) -;; - OpenLDAP (http://www.openldap.org/) +;; - OpenLDAP (https://www.openldap.org/) ;;; Code: diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el index 3c7f243e801..01db97c29d4 100644 --- a/lisp/net/netrc.el +++ b/lisp/net/netrc.el @@ -1,4 +1,5 @@ -;;; netrc.el --- .netrc parsing functionality +;;; netrc.el --- .netrc parsing functionality -*- lexical-binding: t -*- + ;; Copyright (C) 1996-2020 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -40,8 +41,7 @@ (defcustom netrc-file "~/.authinfo" "File where user credentials are stored." :version "24.1" - :type 'file - :group 'netrc) + :type 'file) (defvar netrc-services-file "/etc/services" "The name of the services file.") diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 9401430799c..6d1cf2da71f 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -132,23 +132,89 @@ is not given." domain ;buffer field )))) +;; Poor man's bignums: natural numbers represented as lists of bytes +;; in little-endian order. +;; When this code no longer needs to run on Emacs 26 or older, all this +;; silliness should be simplified to use ordinary Lisp integers. + +(eval-and-compile ; for compile-time simplification + (defun ntlm--bignat-of-int (x) + "Convert the natural number X into a bignat." + (declare (pure t)) + (and (not (zerop x)) + (cons (logand x #xff) (ntlm--bignat-of-int (ash x -8))))) + + (defun ntlm--bignat-add (a b &optional carry) + "Add the bignats A and B and the natural number CARRY." + (declare (pure t)) + (and (or a b (and carry (not (zerop carry)))) + (let ((s (+ (if a (car a) 0) + (if b (car b) 0) + (or carry 0)))) + (cons (logand s #xff) + (ntlm--bignat-add (cdr a) (cdr b) (ash s -8)))))) + + (defun ntlm--bignat-shift-left (x n) + "Multiply the bignat X by 2^{8N}." + (declare (pure t)) + (if (zerop n) x (ntlm--bignat-shift-left (cons 0 x) (1- n)))) + + (defun ntlm--bignat-mul-byte (a b) + "Multiply the bignat A with the byte B." + (declare (pure t)) + (let ((p (mapcar (lambda (x) (* x b)) a))) + (ntlm--bignat-add + (mapcar (lambda (x) (logand x #xff)) p) + (cons 0 (mapcar (lambda (x) (ash x -8)) p))))) + + (defun ntlm--bignat-mul (a b) + "Multiply the bignats A and B." + (declare (pure t)) + (and a b (ntlm--bignat-add (ntlm--bignat-mul-byte a (car b)) + (cons 0 (ntlm--bignat-mul a (cdr b)))))) + + (defun ntlm--bignat-of-string (s) + "Convert the string S (in decimal) to a bignat." + (declare (pure t)) + (ntlm--bignat-of-digits (reverse (string-to-list s)))) + + (defun ntlm--bignat-of-digits (digits) + "Convert the little-endian list DIGITS of decimal digits to a bignat." + (declare (pure t)) + (and digits + (ntlm--bignat-add + nil + (ntlm--bignat-mul-byte (ntlm--bignat-of-digits (cdr digits)) 10) + (- (car digits) ?0)))) + + (defun ntlm--bignat-to-int64 (x) + "Convert the bignat X to a 64-bit little-endian number as a string." + (declare (pure t)) + (apply #'unibyte-string (mapcar (lambda (n) (or (nth n x) 0)) + (number-sequence 0 7)))) + ) + (defun ntlm--time-to-timestamp (time) "Convert TIME to an NTLMv2 timestamp. Return a unibyte string representing the number of tenths of a microsecond since January 1, 1601 as a 64-bit little-endian signed integer. TIME must be on the form (HIGH LOW USEC PSEC)." - (let* ((s (+ (ash (nth 0 time) 16) (nth 1 time))) - (us (nth 2 time)) - (ps (nth 3 time)) + (let* ((s-hi (ntlm--bignat-of-int (nth 0 time))) + (s-lo (ntlm--bignat-of-int (nth 1 time))) + (s (ntlm--bignat-add (ntlm--bignat-shift-left s-hi 2) s-lo)) + (us*10 (ntlm--bignat-of-int (* (nth 2 time) 10))) + (ps/1e5 (ntlm--bignat-of-int (/ (nth 3 time) 100000))) + ;; tenths of microseconds between 1601-01-01 and 1970-01-01 + (to-unix-epoch (ntlm--bignat-of-string "116444736000000000")) (tenths-of-us-since-jan-1-1601 - (+ (* s 10000000) (* us 10) (/ ps 100000) - ;; tenths of microseconds between 1601-01-01 and 1970-01-01 - 116444736000000000))) - (apply #'unibyte-string - (mapcar (lambda (i) - (logand (ash tenths-of-us-since-jan-1-1601 (* i -8)) - #xff)) - (number-sequence 0 7))))) + (ntlm--bignat-add + (ntlm--bignat-add + (ntlm--bignat-add + (ntlm--bignat-mul s (ntlm--bignat-of-int 10000000)) + us*10) + ps/1e5) + to-unix-epoch))) + (ntlm--bignat-to-int64 tenths-of-us-since-jan-1-1601))) (defun ntlm-compute-timestamp () "Current time as an NTLMv2 timestamp, as a unibyte string." diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el index d6dc008e87a..7475a7b59d5 100644 --- a/lisp/net/sieve-mode.el +++ b/lisp/net/sieve-mode.el @@ -1,4 +1,4 @@ -;;; sieve-mode.el --- Sieve code editing commands for Emacs +;;; sieve-mode.el --- Sieve code editing commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index 441e6b14f7b..76d9ced58a6 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -24,9 +24,7 @@ ;; INTRODUCTION ;; ------------ -;; This package provides a major mode for editing SNMP MIBs. It -;; provides all the modern Emacs 19 bells and whistles: default -;; fontification via font-lock, imenu search functions, etc. +;; This package provides a major mode for editing SNMP MIBs. ;; ;; SNMP mode also uses tempo, a textual boilerplate insertion package ;; distributed with Emacs, to add in boilerplate SNMP MIB structures. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 9502cc35300..931a9717310 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -163,7 +163,7 @@ "List of suffixes which indicate a file archive. It must be supported by libarchive(3).") -;; <http://unix-memo.readthedocs.io/en/latest/vfs.html> +;; <https://unix-memo.readthedocs.io/en/latest/vfs.html> ;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, mtree, iso9660, compress. ;; read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2c7c6dae755..f1b45ee851e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -480,7 +480,7 @@ The string is used in `tramp-methods'.") ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin ;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin -;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! +;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! ;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin ;; IRIX64: /usr/bin ;; QNAP QTS: --- @@ -2809,7 +2809,7 @@ implementation will be used." (signal 'wrong-type-argument (list #'stringp name))) (unless (or (null buffer) (bufferp buffer) (stringp buffer)) (signal 'wrong-type-argument (list #'stringp buffer))) - (unless (consp command) + (unless (or (null command) (consp command)) (signal 'wrong-type-argument (list #'consp command))) (unless (or (null coding) (and (symbolp coding) (memq coding coding-system-list)) @@ -4388,7 +4388,7 @@ process to set up. VEC specifies the connection." (t (tramp-message vec 5 "Checking remote host type for `send-process-string' bug") - (if (string-match-p "^FreeBSD" uname) 500 0)))) + (if (string-match-p "FreeBSD\\|DragonFly" uname) 500 0)))) ;; Set remote PATH variable. (tramp-set-remote-path vec) @@ -4415,7 +4415,7 @@ process to set up. VEC specifies the connection." (tramp-send-command vec "set +H" t)) ;; Disable tab expansion. - (if (string-match-p "BSD\\|Darwin" uname) + (if (string-match-p "BSD\\|DragonFly\\|Darwin" uname) (tramp-send-command vec "stty tabs" t) (tramp-send-command vec "stty tab0" t)) diff --git a/lisp/notifications.el b/lisp/notifications.el index 3c2a8cf39c0..f83898622ec 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -23,7 +23,7 @@ ;;; Commentary: ;; This package provides an implementation of the Desktop Notifications -;; <http://developer.gnome.org/notification-spec/>. +;; <https://developer.gnome.org/notification-spec/>. ;; In order to activate this package, you must add the following code ;; into your .emacs: diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el index f5bdf79349a..622ba911995 100644 --- a/lisp/nxml/xsd-regexp.el +++ b/lisp/nxml/xsd-regexp.el @@ -24,7 +24,7 @@ ;; This handles the regular expressions in the syntax defined by: ;; W3C XML Schema Part 2: Datatypes -;; <http://www.w3.org/TR/xmlschema-2/#regexs> +;; <https://www.w3.org/TR/xmlschema-2/#regexs> ;; ;; The main entry point is `xsdre-translate'. ;; @@ -1219,7 +1219,7 @@ Code is inserted into the current buffer." ;; The rest of the file was auto-generated by doing M-x xsdre-gen-categories ;; on UnicodeData-3.1.0.txt available from -;; http://www.unicode.org/Public/3.1-Update/UnicodeData-3.1.0.txt +;; https://www.unicode.org/Public/3.1-Update/UnicodeData-3.1.0.txt (xsdre-def-primitive-category 'Lu '((65 . 90) diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el index 56a57cdf649..d04a40dd3b3 100644 --- a/lisp/org/ob-coq.el +++ b/lisp/org/ob-coq.el @@ -27,7 +27,7 @@ ;; session evaluation is supported. Requires both coq.el and ;; coq-inferior.el, both of which are distributed with Coq. ;; -;; http://coq.inria.fr/ +;; https://coq.inria.fr/ ;;; Code: (require 'ob) diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index 8f66d102074..655e253d925 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -30,11 +30,11 @@ ;;; Requirements: -;; - a non-browser javascript engine such as node.js http://nodejs.org/ -;; or mozrepl http://wiki.github.com/bard/mozrepl/ +;; - a non-browser javascript engine such as node.js https://nodejs.org/ +;; or mozrepl https://wiki.github.com/bard/mozrepl/ ;; ;; - for session based evaluation mozrepl and moz.el are required see -;; http://wiki.github.com/bard/mozrepl/emacs-integration for +;; https://wiki.github.com/bard/mozrepl/emacs-integration for ;; configuration instructions ;;; Code: diff --git a/lisp/org/ob-vala.el b/lisp/org/ob-vala.el index e9c214f7dfc..b1c22756226 100644 --- a/lisp/org/ob-vala.el +++ b/lisp/org/ob-vala.el @@ -26,7 +26,7 @@ ;;; Commentary: ;; ob-vala.el provides Babel support for the Vala language -;; (see http://live.gnome.org/Vala for details) +;; (see https://live.gnome.org/Vala for details) ;;; Requirements: diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index 9ae2700549c..fe3b5f8da10 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -4,7 +4,7 @@ ;; ;; Author: Rasmus Pank Roulund <emacs at pank dot eu> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org +;; Homepage: https://orgmode.org ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index d7c5b381d29..fa84b31675e 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -67,12 +67,13 @@ nil (function (lambda (entry) - (when (and (file-readable-p entry) - (file-regular-p entry)) - (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'" - entry))) - (or (and unzip-p zipped) - (and (not unzip-p) (not zipped))))))))) + (or (file-directory-p entry) + (when (and (file-readable-p entry) + (file-regular-p entry)) + (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'" + entry))) + (or (and unzip-p zipped) + (and (not unzip-p) (not zipped)))))))))) ;;;###autoload (defun pcomplete/bzip2 () diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el index 6e96a67b7b2..0fd426e3d1f 100644 --- a/lisp/pcmpl-x.el +++ b/lisp/pcmpl-x.el @@ -141,7 +141,7 @@ (pcomplete-here* (pcomplete-dirs-or-entries))))))) -;;;; ack - http://betterthangrep.com +;;;; ack - https://betterthangrep.com ;; Usage: ;; - To complete short options type '-' first diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 00fcb804d43..9dacd5856cf 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -52,7 +52,7 @@ ;; ;; * Probably. Show rules/dependencies for ANT like for Makefile (does ANT ;; support vocabularies and grammar inheritance?), I have to look at -;; jde-ant.el: http://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html +;; jde-ant.el: https://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html ;; * Probably. Make `indent-region' faster, especially in actions. ELP ;; profiling in a class init action shows half the time is spent in ;; `antlr-next-rule', the other half in `c-guess-basic-syntax'. diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el index 65090ac3ca5..cb6bd6c34bb 100644 --- a/lisp/progmodes/cl-font-lock.el +++ b/lisp/progmodes/cl-font-lock.el @@ -23,7 +23,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 9188a08e780..de0ea428d5e 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1242,12 +1242,12 @@ POS and RES.") 2))) ;; Remove matches like /bin/sh and do other file name transforms. (save-match-data - (let ((file-name - (and (consp file) - (not (bufferp (car file))) - (if (cdr file) - (expand-file-name (car file) (cdr file)) - (car file))))) + (when-let ((file-name + (and (consp file) + (not (bufferp (car file))) + (if (cdr file) + (expand-file-name (car file) (cdr file)) + (car file))))) (cl-loop for (regexp replacement) in compilation-transform-file-match-alist when (string-match regexp file-name) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index eed73f57918..ce2b924d514 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -897,8 +897,10 @@ non-nil result supersedes the xrefs produced by (let ((buffer-point (find-function-search-for-symbol symbol type file))) (with-current-buffer (car buffer-point) (save-excursion - (goto-char (or (cdr buffer-point) (point-min))) - (point-marker)))))) + (save-restriction + (widen) + (goto-char (or (cdr buffer-point) (point-min))) + (point-marker))))))) (cl-defmethod xref-location-group ((l xref-elisp-location)) (xref-elisp-location-file l)) @@ -1411,6 +1413,30 @@ which see." or argument string for functions. 2 - `function' if function args, `variable' if variable documentation.") +(defun elisp--documentation-one-liner () + (let* (str + (callback (lambda (doc &rest plist) + (setq str + (format "%s: %s" + (propertize (prin1-to-string + (plist-get plist :thing)) + 'face (plist-get plist :face)) + doc))))) + (or (progn (elisp-eldoc-var-docstring callback) str) + (progn (elisp-eldoc-funcall callback) str)))) + +(defalias 'elisp-eldoc-documentation-function 'elisp--documentation-one-liner + "Return Elisp documentation for the thing at point as one-line string. +This is meant as a backward compatibility aide to the \"old\" +Elisp eldoc behaviour. Consider variable docstrings and function +signatures only, in this order. If none applies, returns nil. +Changes to `eldoc-documentation-functions' and +`eldoc-documentation-strategy' are _not_ reflected here. As such +it is preferrable to use ElDoc's interfaces directly.") + +(make-obsolete 'elisp-eldoc-documentation-function + "use ElDoc's interfaces instead." "28.1") + (defun elisp-eldoc-funcall (callback &rest _ignored) "Document function call at point. Intended for `eldoc-documentation-functions' (which see)." diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index f6af1f2ea84..41ed3177660 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1406,8 +1406,13 @@ hits the start of file." offset (* 3 offset))) ; expand search window (or found (re-search-forward pat nil t) - (user-error "Rerun etags: `%s' not found in %s" - pat buffer-file-name))) + (if (and (buffer-narrowed-p) widen-automatically) + (progn + ;; Rerun after removing narrowing + (widen) + (etags-goto-tag-location tag-info)) + (user-error "Rerun etags: `%s' not found in %s" + pat buffer-file-name)))) ;; Position point at the right place ;; if the search string matched an extra Ctrl-m at the beginning. (and (eq selective-display t) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 9e8af84a600..4bebf88d356 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -89,8 +89,6 @@ ;;; Code: (require 'gud) -(require 'json) -(require 'bindat) (require 'cl-lib) (require 'cl-seq) (eval-when-compile (require 'pcase)) @@ -167,7 +165,7 @@ May be manually changed by user with `gdb-select-frame'.") "Associative list of threads provided by \"-thread-info\" MI command. Keys are thread numbers (in strings) and values are structures as -returned from -thread-info by `gdb-json-partial-output'. Updated in +returned from -thread-info by `gdb-mi--partial-output'. Updated in `gdb-thread-list-handler-custom'.") (defvar gdb-running-threads-count nil @@ -186,7 +184,7 @@ See also `gdb-running-threads-count'.") "Associative list of breakpoints provided by \"-break-list\" MI command. Keys are breakpoint numbers (in string) and values are structures -as returned from \"-break-list\" by `gdb-json-partial-output' +as returned from \"-break-list\" by `gdb-mi--partial-output' \(\"body\" field is used). Updated in `gdb-breakpoints-list-handler-custom'.") @@ -516,8 +514,6 @@ contains fields of corresponding MI *stopped async record: Note that \"reason\" is only present in non-stop debugging mode. -`bindat-get-field' may be used to access the fields of response. - Each function is called after the new current thread was selected and GDB buffers were updated in `gdb-stopped'." :type '(repeat function) @@ -740,8 +736,10 @@ NOARG must be t when this macro is used outside `gud-def'." (unless (zerop (length string)) (remove-function (process-filter proc) #'gdb--check-interpreter) (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=)) - ;; Apparently we're not running with -i=mi. - (let ((msg "Error: you did not specify -i=mi on GDB's command line!")) + ;; Apparently we're not running with -i=mi (or we're, for + ;; instance, debugging something inside a Docker instance with + ;; Emacs on the outside). + (let ((msg "Error: Either -i=mi wasn't specified on the GDB command line, or the extra socket couldn't be established. Consider using `M-x gud-gdb' instead.")) (message msg) (setq string (concat (propertize msg 'font-lock-face 'error) "\n" string))) @@ -1125,11 +1123,11 @@ no input, and GDB is waiting for input." "\\)") nil t) (tooltip-show - (concat expr " = " (read (match-string 1))) + (concat expr " = " (gdb-mi--c-string-from-string (match-string 1))) (or gud-tooltip-echo-area (not (display-graphic-p))))) ((re-search-forward "msg=\\(\".+\"\\)$" nil t) - (tooltip-show (read (match-string 1)) + (tooltip-show (gdb-mi--c-string-from-string (match-string 1)) (or gud-tooltip-echo-area (not (display-graphic-p)))))))) @@ -1142,7 +1140,7 @@ no input, and GDB is waiting for input." (if (search-forward "expands to: " nil t) (unless (looking-at "\\S-+.*(.*).*") (gdb-input (concat "-data-evaluate-expression \"" expr "\"") - `(lambda () (gdb-tooltip-print ,expr))))))) + (lambda () (gdb-tooltip-print expr))))))) (defun gdb-init-buffer () (set (make-local-variable 'gud-minor-mode) 'gdbmi) @@ -1262,23 +1260,26 @@ With arg, enter name of variable to be watched in the minibuffer." (tooltip-identifier-from-point (point))))))) (set-text-properties 0 (length expr) nil expr) (gdb-input (concat "-var-create - * " expr "") - `(lambda () (gdb-var-create-handler ,expr)))))) + (lambda () (gdb-var-create-handler expr)))))) (message "gud-watch is a no-op in this mode.")))) +(defsubst gdb-mi--field (value field) + (cdr (assq field value))) + (defun gdb-var-create-handler (expr) - (let* ((result (gdb-json-partial-output))) - (if (not (bindat-get-field result 'msg)) + (let* ((result (gdb-mi--partial-output))) + (if (not (gdb-mi--field result 'msg)) (let ((var - (list (bindat-get-field result 'name) + (list (gdb-mi--field result 'name) (if (and (string-equal gdb-current-language "c") gdb-use-colon-colon-notation gdb-selected-frame) (setq expr (concat gdb-selected-frame "::" expr)) expr) - (bindat-get-field result 'numchild) - (bindat-get-field result 'type) - (bindat-get-field result 'value) + (gdb-mi--field result 'numchild) + (gdb-mi--field result 'type) + (gdb-mi--field result 'value) nil - (bindat-get-field result 'has_more) + (gdb-mi--field result 'has_more) gdb-frame-address))) (push var gdb-var-list) (speedbar 1) @@ -1299,41 +1300,31 @@ With arg, enter name of variable to be watched in the minibuffer." (raise-frame speedbar-frame)) (speedbar-timer-fn)) -(defun gdb-var-evaluate-expression-handler (varnum changed) - (goto-char (point-min)) - (re-search-forward (concat ".*value=\\(" gdb--string-regexp "\\)") - nil t) - (let ((var (assoc varnum gdb-var-list))) - (when var - (if changed (setcar (nthcdr 5 var) 'changed)) - (setcar (nthcdr 4 var) (read (match-string 1))))) - (gdb-speedbar-update)) - ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. (defun gdb-var-list-children (varnum) (gdb-input (concat "-var-update " varnum) 'ignore) (gdb-input (concat "-var-list-children --all-values " varnum) - `(lambda () (gdb-var-list-children-handler ,varnum)))) + (lambda () (gdb-var-list-children-handler varnum)))) (defun gdb-var-list-children-handler (varnum) (let* ((var-list nil) - (output (gdb-json-partial-output "child")) - (children (bindat-get-field output 'children))) + (output (gdb-mi--partial-output 'child)) + (children (gdb-mi--field output 'children))) (catch 'child-already-watched (dolist (var gdb-var-list) (if (string-equal varnum (car var)) (progn ;; With dynamic varobjs numchild may have increased. - (setcar (nthcdr 2 var) (bindat-get-field output 'numchild)) + (setcar (nthcdr 2 var) (gdb-mi--field output 'numchild)) (push var var-list) (dolist (child children) - (let ((varchild (list (bindat-get-field child 'name) - (bindat-get-field child 'exp) - (bindat-get-field child 'numchild) - (bindat-get-field child 'type) - (bindat-get-field child 'value) + (let ((varchild (list (gdb-mi--field child 'name) + (gdb-mi--field child 'exp) + (gdb-mi--field child 'numchild) + (gdb-mi--field child 'type) + (gdb-mi--field child 'value) nil - (bindat-get-field child 'has_more)))) + (gdb-mi--field child 'has_more)))) (if (assoc (car varchild) gdb-var-list) (throw 'child-already-watched nil)) (push varchild var-list)))) @@ -1376,7 +1367,7 @@ With arg, enter name of variable to be watched in the minibuffer." (varnum (car var)) (value (read-string "New value: "))) (gdb-input (concat "-var-assign " varnum " " value) - `(lambda () (gdb-edit-value-handler ,value))))) + (lambda () (gdb-edit-value-handler value))))) (defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)") @@ -1392,17 +1383,17 @@ With arg, enter name of variable to be watched in the minibuffer." 'gdb-var-update)) (defun gdb-var-update-handler () - (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist))) + (let ((changelist (gdb-mi--field (gdb-mi--partial-output) 'changelist))) (dolist (var gdb-var-list) (setcar (nthcdr 5 var) nil)) (let ((temp-var-list gdb-var-list)) (dolist (change changelist) - (let* ((varnum (bindat-get-field change 'name)) + (let* ((varnum (gdb-mi--field change 'name)) (var (assoc varnum gdb-var-list)) - (new-num (bindat-get-field change 'new_num_children))) + (new-num (gdb-mi--field change 'new_num_children))) (when var - (let ((scope (bindat-get-field change 'in_scope)) - (has-more (bindat-get-field change 'has_more))) + (let ((scope (gdb-mi--field change 'in_scope)) + (has-more (gdb-mi--field change 'has_more))) (cond ((string-equal scope "false") (if gdb-delete-out-of-scope (gdb-var-delete-1 var varnum) @@ -1414,12 +1405,12 @@ With arg, enter name of variable to be watched in the minibuffer." (not new-num) (string-equal (nth 2 var) "0")) (setcar (nthcdr 4 var) - (bindat-get-field change 'value)) + (gdb-mi--field change 'value)) (setcar (nthcdr 5 var) 'changed))) ((string-equal scope "invalid") (gdb-var-delete-1 var varnum))))) (let ((var-list nil) var1 - (children (bindat-get-field change 'new_children))) + (children (gdb-mi--field change 'new_children))) (when new-num (setq var1 (pop temp-var-list)) (while var1 @@ -1435,13 +1426,13 @@ With arg, enter name of variable to be watched in the minibuffer." (push (pop temp-var-list) var-list)) (dolist (child children) (let ((varchild - (list (bindat-get-field child 'name) - (bindat-get-field child 'exp) - (bindat-get-field child 'numchild) - (bindat-get-field child 'type) - (bindat-get-field child 'value) + (list (gdb-mi--field child 'name) + (gdb-mi--field child 'exp) + (gdb-mi--field child 'numchild) + (gdb-mi--field child 'type) + (gdb-mi--field child 'value) 'changed - (bindat-get-field child 'has_more)))) + (gdb-mi--field child 'has_more)))) (push varchild var-list)))) ;; Remove deleted children from list. ((< new previous) @@ -1522,7 +1513,7 @@ thread." (defun gdb-current-buffer-frame () "Get current stack frame object for thread of current buffer." - (bindat-get-field (gdb-current-buffer-thread) 'frame)) + (gdb-mi--field (gdb-current-buffer-thread) 'frame)) (defun gdb-buffer-type (buffer) "Get value of `gdb-buffer-type' for BUFFER." @@ -1584,9 +1575,9 @@ this trigger is subscribed to `gdb-buf-publisher' and called with (defun gdb-bind-function-to-buffer (expr buffer) "Return a function which will evaluate EXPR in BUFFER." - `(lambda (&rest args) - (with-current-buffer ,buffer - (apply ',expr args)))) + (lambda (&rest args) + (with-current-buffer buffer + (apply expr args)))) ;; Used to display windows with thread-bound buffers (defmacro def-gdb-preempt-display-buffer (name buffer &optional doc @@ -2057,7 +2048,7 @@ For all-stop mode, thread information is unavailable while target is running." (let ((old-value gud-running)) (setq gud-running - (string= (bindat-get-field (gdb-current-buffer-thread) 'state) + (string= (gdb-mi--field (gdb-current-buffer-thread) 'state) "running")) ;; Set frame number to "0" when _current_ threads stops. (when (and (gdb-current-buffer-thread) @@ -2314,7 +2305,8 @@ a GDB/MI reply message." ;; Suppress "No registers." GDB 6.8 and earlier ;; duplicates MI error message on internal stream. ;; Don't print to GUD buffer. - (if (not (string-equal (read c-string) "No registers.\n")) + (if (not (string-equal (gdb-mi--c-string-from-string c-string) + "No registers.\n")) (gdb-internals c-string))) @@ -2436,7 +2428,7 @@ the end of the current result or async record is reached." is-complete))) -; The following grammar rules are not yet implemented by this GDBMI-BNF parser. +; The following grammar rules are not parsed directly by this GDBMI-BNF parser. ; The handling of those rules is currently done by the handlers registered ; in gdbmi-bnf-result-state-configs ; @@ -2458,19 +2450,17 @@ the end of the current result or async record is reached." ; list ==> ; "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]" +;; FIXME: This is fragile: it relies on the assumption that all the +;; non-ASCII strings output by GDB, including names of the source +;; files, values of string variables in the inferior, etc., are all +;; encoded in the same encoding. + (defcustom gdb-mi-decode-strings nil "When non-nil, decode octal escapes in GDB output into non-ASCII text. If the value is a coding-system, use that coding-system to decode the bytes reconstructed from octal escapes. Any other non-nil value -means to decode using the coding-system set for the GDB process. - -Warning: setting this non-nil might mangle strings reported by GDB -that have literal substrings which match the \\nnn octal escape -patterns, where nnn is an octal number between 200 and 377. So -we only recommend to set this variable non-nil if the program you -are debugging really reports non-ASCII text, or some of its source -file names include non-ASCII characters." +means to decode using the coding-system set for the GDB process." :type '(choice (const :tag "Don't decode" nil) (const :tag "Decode using default coding-system" t) @@ -2478,47 +2468,9 @@ file names include non-ASCII characters." :group 'gdb :version "25.1") -;; The idea of the following function was suggested -;; by Kenichi Handa <handa@gnu.org>. -;; -;; FIXME: This is fragile: it relies on the assumption that all the -;; non-ASCII strings output by GDB, including names of the source -;; files, values of string variables in the inferior, etc., are all -;; encoded in the same encoding. It also assumes that the \nnn -;; sequences are not split between chunks of output of the GDB process -;; due to buffering, and arrive together. Finally, if some string -;; included literal \nnn strings (as opposed to non-ASCII characters -;; converted by GDB/MI to octal escapes), this decoding will mangle -;; those strings. When/if GDB acquires the ability to not -;; escape-protect non-ASCII characters in its MI output, this kludge -;; should be removed. -(defun gdb-mi-decode (string) - "Decode octal escapes in MI output STRING into multibyte text." - (let ((coding - (if (coding-system-p gdb-mi-decode-strings) - gdb-mi-decode-strings - (with-current-buffer - (gdb-get-buffer-create 'gdb-partial-output-buffer) - buffer-file-coding-system)))) - (with-temp-buffer - (set-buffer-multibyte nil) - (prin1 string (current-buffer)) - (goto-char (point-min)) - ;; prin1 quotes the octal escapes as well, which interferes with - ;; their interpretation by 'read' below. Remove the extra - ;; backslashes to countermand that. - (while (re-search-forward "\\\\\\(\\\\[2-3][0-7][0-7]\\)" nil t) - (replace-match "\\1" nil nil)) - (goto-char (point-min)) - (decode-coding-string (read (current-buffer)) coding)))) - (defun gud-gdbmi-marker-filter (string) "Filter GDB/MI output." - ;; If required, decode non-ASCII text encoded with octal escapes. - (or (null gdb-mi-decode-strings) - (setq string (gdb-mi-decode string))) - ;; Record transactions if logging is enabled. (when gdb-enable-debug (push (cons 'recv string) gdb-debug-log) @@ -2565,7 +2517,7 @@ file names include non-ASCII characters." (defun gdb-thread-exited (_token output-field) "Handle =thread-exited async record. Unset `gdb-thread-number' if current thread exited and update threads list." - (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id))) + (let* ((thread-id (gdb-mi--field (gdb-mi--from-string output-field) 'id))) (if (string= gdb-thread-number thread-id) (gdb-setq-thread-number nil)) ;; When we continue current thread and it quickly exits, @@ -2579,8 +2531,8 @@ Unset `gdb-thread-number' if current thread exited and update threads list." "Handler for =thread-selected MI output record. Sets `gdb-thread-number' to new id." - (let* ((result (gdb-json-string output-field)) - (thread-id (bindat-get-field result 'id))) + (let* ((result (gdb-mi--from-string output-field)) + (thread-id (gdb-mi--field result 'id))) (gdb-setq-thread-number thread-id) ;; Typing `thread N' in GUD buffer makes GDB emit `^done' followed ;; by `=thread-selected' notification. `^done' causes `gdb-update' @@ -2595,7 +2547,7 @@ Sets `gdb-thread-number' to new id." (defun gdb-running (_token output-field) (let* ((thread-id - (bindat-get-field (gdb-json-string output-field) 'thread-id))) + (gdb-mi--field (gdb-mi--from-string output-field) 'thread-id))) ;; We reset gdb-frame-number to nil if current thread has gone ;; running. This can't be done in gdb-thread-list-handler-custom ;; because we need correct gdb-frame-number by the time @@ -2624,11 +2576,11 @@ Sets `gdb-thread-number' to new id." "Given the contents of *stopped MI async record, select new current thread and update GDB buffers." ;; Reason is available with target-async only - (let* ((result (gdb-json-string output-field)) - (reason (bindat-get-field result 'reason)) - (thread-id (bindat-get-field result 'thread-id)) - (retval (bindat-get-field result 'return-value)) - (varnum (bindat-get-field result 'gdb-result-var))) + (let* ((result (gdb-mi--from-string output-field)) + (reason (gdb-mi--field result 'reason)) + (thread-id (gdb-mi--field result 'thread-id)) + (retval (gdb-mi--field result 'return-value)) + (varnum (gdb-mi--field result 'gdb-result-var))) ;; -data-list-register-names needs to be issued for any stopped ;; thread @@ -2671,7 +2623,7 @@ current thread and update GDB buffers." ;; gdb-switch-when-another-stopped: (when (or gdb-switch-when-another-stopped (not (string= "stopped" - (bindat-get-field (gdb-current-buffer-thread) 'state)))) + (gdb-mi--field (gdb-current-buffer-thread) 'state)))) ;; Switch if current reason has been selected or we have no ;; reasons (if (or (eq gdb-switch-reasons t) @@ -2704,7 +2656,7 @@ current thread and update GDB buffers." (if (string= output-field "\"\\n\"") "" (let ((error-message - (read output-field))) + (gdb-mi--c-string-from-string output-field))) (put-text-property 0 (length error-message) 'face font-lock-warning-face @@ -2715,7 +2667,8 @@ current thread and update GDB buffers." ;; (frontend MI commands should not print to this stream) (defun gdb-console (output-field) (setq gdb-filter-output - (gdb-concat-output gdb-filter-output (read output-field)))) + (gdb-concat-output gdb-filter-output + (gdb-mi--c-string-from-string output-field)))) (defun gdb-done (token-number output-field is-complete) (gdb-done-or-error token-number 'done output-field is-complete)) @@ -2732,7 +2685,8 @@ current thread and update GDB buffers." ;; MI error - send to minibuffer (when (eq type 'error) ;; Skip "msg=" from `output-field' - (message "%s" (read (substring output-field 4))) + (message "%s" (gdb-mi--c-string-from-string + (substring output-field 4))) ;; Don't send to the console twice. (If it is a console error ;; it is also in the console stream.) (setq output-field nil))) @@ -2780,83 +2734,154 @@ current thread and update GDB buffers." (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) (erase-buffer))) -(defun gdb-jsonify-buffer (&optional fix-key fix-list) - "Prepare GDB/MI output in current buffer for parsing with `json-read'. - -Field names are wrapped in double quotes and equal signs are -replaced with semicolons. - -If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from -partial output. This is used to get rid of useless keys in lists -in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and --break-info are examples of MI commands which issue such -responses. - -If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with -\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken --break-info output when it contains breakpoint script field -incompatible with GDB/MI output syntax. +;; Parse GDB/MI result records: this process converts +;; list [...] -> list +;; tuple {...} -> list +;; result KEY=VALUE -> (KEY . VALUE) where KEY is a symbol +;; c-string "..." -> string + +(defun gdb-mi--parse-tuple-or-list (end-char) + "Parse a tuple or list, either returned as a Lisp list. +END-CHAR is the ending delimiter; will stop at end-of-buffer otherwise." + (let ((items nil)) + (while (not (or (eobp) + (eq (following-char) end-char))) + (let ((item (gdb-mi--parse-result-or-value))) + (push item items) + (when (eq (following-char) ?,) + (forward-char)))) + (when (eq (following-char) end-char) + (forward-char)) + (nreverse items))) + +(defun gdb-mi--parse-c-string () + "Parse a c-string." + (let ((start (point)) + (pieces nil) + (octals-used nil)) + (while (and (re-search-forward (rx (or ?\\ ?\"))) + (not (eq (preceding-char) ?\"))) + (push (buffer-substring start (1- (point))) pieces) + (cond + ((looking-at (rx (any "0-7") (? (any "0-7") (? (any "0-7"))))) + (push (unibyte-string (string-to-number (match-string 0) 8)) pieces) + (setq octals-used t) + (goto-char (match-end 0))) + ((looking-at (rx (any "ntrvfab\"\\"))) + (push (cdr (assq (following-char) + '((?n . "\n") + (?t . "\t") + (?r . "\r") + (?v . "\v") + (?f . "\f") + (?a . "\a") + (?b . "\b") + (?\" . "\"") + (?\\ . "\\")))) + pieces) + (forward-char)) + (t + (warn "Unrecognised escape char: %c" (following-char)))) + (setq start (point))) + (push (buffer-substring start (1- (point))) pieces) + (let ((s (apply #'concat (nreverse pieces)))) + (if (and octals-used gdb-mi-decode-strings) + (let ((coding + (if (coding-system-p gdb-mi-decode-strings) + gdb-mi-decode-strings + (buffer-local-value + 'buffer-file-coding-system + ;; FIXME: This is somewhat expensive. + (gdb-get-buffer-create 'gdb-partial-output-buffer))))) + (decode-coding-string s coding)) + s)))) + +;; FIXME: Ideally this function should not be needed. +(defun gdb-mi--c-string-from-string (string) + "Parse a c-string from (the beginning of) STRING." + (with-temp-buffer + (insert string) + (goto-char (1+ (point-min))) ; Skip leading double quote. + (gdb-mi--parse-c-string))) -If `default-directory' is remote, full file names are adapted accordingly." - (save-excursion +(defun gdb-mi--parse-value () + "Parse a value." + (cond + ((eq (following-char) ?\{) + (forward-char) + (gdb-mi--parse-tuple-or-list ?\})) + ((eq (following-char) ?\[) + (forward-char) + (gdb-mi--parse-tuple-or-list ?\])) + ((eq (following-char) ?\") + (forward-char) + (gdb-mi--parse-c-string)) + (t (error "Bad start of result or value: %c" (following-char))))) + +(defun gdb-mi--parse-result-or-value () + "Parse a result (key=value) or value." + (if (looking-at (rx (group (+ (any "a-zA-Z" ?_ ?-))) "=")) + (progn + (goto-char (match-end 0)) + (let* ((variable (intern (match-string 1))) + (value (gdb-mi--parse-value))) + (cons variable value))) + (gdb-mi--parse-value))) + +(defun gdb-mi--parse-results () + "Parse zero or more result productions as a list." + (gdb-mi--parse-tuple-or-list nil)) + +(defun gdb-mi--fix-key (key value) + "Convert any result (key-value pair) in VALUE whose key is KEY to its value." + (cond + ((atom value) value) + ((symbolp (car value)) + (if (eq (car value) key) + (cdr value) + (cons (car value) (gdb-mi--fix-key key (cdr value))))) + (t (mapcar (lambda (x) (gdb-mi--fix-key key x)) value)))) + +(defun gdb-mi--extend-fullname (remote value) + "Prepend REMOTE to any result string with `fullname' as the key in VALUE." + (cond + ((atom value) value) + ((symbolp (car value)) + (if (and (eq (car value) 'fullname) + (stringp (cdr value))) + (cons 'fullname (concat remote (cdr value))) + (cons (car value) (gdb-mi--extend-fullname remote (cdr value))))) + (t (mapcar (lambda (x) (gdb-mi--extend-fullname remote x)) value)))) + +(defun gdb-mi--read-buffer (fix-key) + "Parse the current buffer as a list of result productions. +If FIX-KEY is a non-nil symbol, convert all FIX-KEY=VALUE results into VALUE. +This is used to get rid of useless keys in lists in MI messages; +eg, [key=.., key=..]. -stack-list-frames and -break-info are +examples of MI commands which issue such responses." + (goto-char (point-min)) + (let ((results (gdb-mi--parse-results))) (let ((remote (file-remote-p default-directory))) (when remote - (goto-char (point-min)) - (while (re-search-forward "[\\[,]fullname=\"\\(.+\\)\"" nil t) - (replace-match (concat remote "\\1") nil nil nil 1)))) - (goto-char (point-min)) + (setq results (gdb-mi--extend-fullname remote results)))) (when fix-key - (save-excursion - (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t) - (replace-match "" nil nil nil 1)))) - (when fix-list - (save-excursion - ;; Find positions of braces which enclose broken list - (while (re-search-forward (concat fix-list "={\"") nil t) - (let ((p1 (goto-char (- (point) 2))) - (p2 (progn (forward-sexp) - (1- (point))))) - ;; Replace braces with brackets - (save-excursion - (goto-char p1) - (delete-char 1) - (insert "[") - (goto-char p2) - (delete-char 1) - (insert "]")))))) - (goto-char (point-min)) - (insert "{") - (let ((re (concat "\\([[:alnum:]_-]+\\)="))) - (while (re-search-forward re nil t) - (replace-match "\"\\1\":" nil nil) - (if (eq (char-after) ?\") (forward-sexp) (forward-char)))) - (goto-char (point-max)) - (insert "}"))) + (setq results (gdb-mi--fix-key fix-key results))) + results)) -(defun gdb-json-read-buffer (&optional fix-key fix-list) - "Prepare and parse GDB/MI output in current buffer with `json-read'. +(defun gdb-mi--from-string (string &optional fix-key) + "Prepare and parse STRING containing GDB/MI output. -FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'." - (gdb-jsonify-buffer fix-key fix-list) - (save-excursion - (goto-char (point-min)) - (let ((json-array-type 'list)) - (json-read)))) - -(defun gdb-json-string (string &optional fix-key fix-list) - "Prepare and parse STRING containing GDB/MI output with `json-read'. - -FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'." +FIX-KEY works as in `gdb-mi--read-buffer'." (with-temp-buffer (insert string) - (gdb-json-read-buffer fix-key fix-list))) + (gdb-mi--read-buffer fix-key))) -(defun gdb-json-partial-output (&optional fix-key fix-list) - "Prepare and parse gdb-partial-output-buffer with `json-read'. +(defun gdb-mi--partial-output (&optional fix-key) + "Prepare and parse gdb-partial-output-buffer. -FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'." +FIX-KEY works as in `gdb-mi--read-buffer'." (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (gdb-json-read-buffer fix-key fix-list))) + (gdb-mi--read-buffer fix-key))) (defun gdb-line-posns (line) "Return a pair of LINE beginning and end positions." @@ -2937,14 +2962,6 @@ calling `gdb-table-string'." (gdb-table-row-properties table)) "\n"))) -;; bindat-get-field goes deep, gdb-get-many-fields goes wide -(defun gdb-get-many-fields (struct &rest fields) - "Return a list of FIELDS values from STRUCT." - (let ((values)) - (dolist (field fields) - (push (bindat-get-field struct field) values)) - (nreverse values))) - (defmacro def-gdb-auto-update-trigger (trigger-name gdb-command handler-name &optional signal-list) @@ -3032,26 +3049,27 @@ See `def-gdb-auto-update-handler'." 'gdb-invalidate-breakpoints) (defun gdb-breakpoints-list-handler-custom () - (let ((breakpoints-list (bindat-get-field - (gdb-json-partial-output "bkpt" "script") - 'BreakpointTable 'body)) + (let ((breakpoints-list (gdb-mi--field + (gdb-mi--field (gdb-mi--partial-output 'bkpt) + 'BreakpointTable) + 'body)) (table (make-gdb-table))) (setq gdb-breakpoints-list nil) (gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Addr" "Hits" "What")) (dolist (breakpoint breakpoints-list) (add-to-list 'gdb-breakpoints-list - (cons (bindat-get-field breakpoint 'number) + (cons (gdb-mi--field breakpoint 'number) breakpoint)) - (let ((at (bindat-get-field breakpoint 'at)) - (pending (bindat-get-field breakpoint 'pending)) - (func (bindat-get-field breakpoint 'func)) - (type (bindat-get-field breakpoint 'type))) + (let ((at (gdb-mi--field breakpoint 'at)) + (pending (gdb-mi--field breakpoint 'pending)) + (func (gdb-mi--field breakpoint 'func)) + (type (gdb-mi--field breakpoint 'type))) (gdb-table-add-row table (list - (bindat-get-field breakpoint 'number) + (gdb-mi--field breakpoint 'number) (or type "") - (or (bindat-get-field breakpoint 'disp) "") - (let ((flag (bindat-get-field breakpoint 'enabled))) + (or (gdb-mi--field breakpoint 'disp) "") + (let ((flag (gdb-mi--field breakpoint 'enabled))) (if (string-equal flag "y") (eval-when-compile (propertize "y" 'font-lock-face @@ -3059,10 +3077,10 @@ See `def-gdb-auto-update-handler'." (eval-when-compile (propertize "n" 'font-lock-face font-lock-comment-face)))) - (bindat-get-field breakpoint 'addr) - (or (bindat-get-field breakpoint 'times) "") + (gdb-mi--field breakpoint 'addr) + (or (gdb-mi--field breakpoint 'times) "") (if (and type (string-match ".*watchpoint" type)) - (bindat-get-field breakpoint 'what) + (gdb-mi--field breakpoint 'what) (or pending at (concat "in " (propertize (or func "unknown") @@ -3087,11 +3105,11 @@ See `def-gdb-auto-update-handler'." (dolist (breakpoint gdb-breakpoints-list) (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is ; an associative list - (line (bindat-get-field breakpoint 'line))) + (line (gdb-mi--field breakpoint 'line))) (when line - (let ((file (bindat-get-field breakpoint 'fullname)) - (flag (bindat-get-field breakpoint 'enabled)) - (bptno (bindat-get-field breakpoint 'number))) + (let ((file (gdb-mi--field breakpoint 'fullname)) + (flag (gdb-mi--field breakpoint 'enabled)) + (bptno (gdb-mi--field breakpoint 'number))) (unless (and file (file-exists-p file)) (setq file (cdr (assoc bptno gdb-location-alist)))) (if (or (null file) @@ -3099,11 +3117,11 @@ See `def-gdb-auto-update-handler'." ;; If the full filename is not recorded in the ;; breakpoint structure or in `gdb-location-alist', use ;; -file-list-exec-source-file to extract it. - (when (setq file (bindat-get-field breakpoint 'file)) + (when (setq file (gdb-mi--field breakpoint 'file)) (gdb-input (concat "list " file ":1") 'ignore) (gdb-input "-file-list-exec-source-file" - `(lambda () (gdb-get-location - ,bptno ,line ,flag)))) + (lambda () (gdb-get-location + bptno line flag)))) (with-current-buffer (find-file-noselect file 'nowarn) (gdb-init-buffer) ;; Only want one breakpoint icon at each location. @@ -3355,7 +3373,7 @@ corresponding to the mode line clicked." 'gdb-invalidate-threads) (defun gdb-thread-list-handler-custom () - (let ((threads-list (bindat-get-field (gdb-json-partial-output) 'threads)) + (let ((threads-list (gdb-mi--field (gdb-mi--partial-output) 'threads)) (table (make-gdb-table)) (marked-line nil)) (setq gdb-threads-list nil) @@ -3364,9 +3382,9 @@ corresponding to the mode line clicked." (set-marker gdb-thread-position nil) (dolist (thread (reverse threads-list)) - (let ((running (equal (bindat-get-field thread 'state) "running"))) + (let ((running (equal (gdb-mi--field thread 'state) "running"))) (add-to-list 'gdb-threads-list - (cons (bindat-get-field thread 'id) + (cons (gdb-mi--field thread 'id) thread)) (cl-incf (if running gdb-running-threads-count @@ -3375,37 +3393,41 @@ corresponding to the mode line clicked." (gdb-table-add-row table (list - (bindat-get-field thread 'id) + (gdb-mi--field thread 'id) (concat (if gdb-thread-buffer-verbose-names - (concat (bindat-get-field thread 'target-id) " ") "") - (bindat-get-field thread 'state) + (concat (gdb-mi--field thread 'target-id) " ") "") + (gdb-mi--field thread 'state) ;; Include frame information for stopped threads (if (not running) (concat - " in " (bindat-get-field thread 'frame 'func) + " in " (gdb-mi--field (gdb-mi--field thread 'frame) 'func) (if gdb-thread-buffer-arguments (concat " (" - (let ((args (bindat-get-field thread 'frame 'args))) + (let ((args (gdb-mi--field (gdb-mi--field thread 'frame) + 'args))) (mapconcat (lambda (arg) - (apply #'format "%s=%s" - (gdb-get-many-fields arg 'name 'value))) + (format "%s=%s" + (gdb-mi--field arg 'name) + (gdb-mi--field arg 'value))) args ",")) ")") "") (if gdb-thread-buffer-locations - (gdb-frame-location (bindat-get-field thread 'frame)) "") + (gdb-frame-location (gdb-mi--field thread 'frame)) "") (if gdb-thread-buffer-addresses - (concat " at " (bindat-get-field thread 'frame 'addr)) "")) + (concat " at " (gdb-mi--field (gdb-mi--field thread 'frame) + 'addr)) + "")) ""))) (list 'gdb-thread thread 'mouse-face 'highlight 'help-echo "mouse-2, RET: select thread"))) (when (string-equal gdb-thread-number - (bindat-get-field thread 'id)) + (gdb-mi--field thread 'id)) (setq marked-line (length gdb-threads-list)))) (insert (gdb-table-string table " ")) (when marked-line @@ -3437,11 +3459,11 @@ If `gdb-thread' is nil, error is signaled." "Define a NAME which will call BUFFER-COMMAND with id of thread on the current line." `(def-gdb-thread-buffer-command ,name - (,buffer-command (bindat-get-field thread 'id)) + (,buffer-command (gdb-mi--field thread 'id)) ,doc)) (def-gdb-thread-buffer-command gdb-select-thread - (let ((new-id (bindat-get-field thread 'id))) + (let ((new-id (gdb-mi--field thread 'id))) (gdb-setq-thread-number new-id) (gdb-input (concat "-thread-select " new-id) 'ignore) (gdb-update)) @@ -3493,7 +3515,7 @@ on the current line." line." `(def-gdb-thread-buffer-command ,name (if gdb-non-stop - (let ((gdb-thread-number (bindat-get-field thread 'id)) + (let ((gdb-thread-number (gdb-mi--field thread 'id)) (gdb-gud-control-all-threads nil)) (call-interactively #',gud-command)) (error "Available in non-stop mode only, customize `gdb-non-stop-setting'")) @@ -3592,20 +3614,20 @@ in `gdb-memory-format'." (error "Unknown format")))) (defun gdb-read-memory-custom () - (let* ((res (gdb-json-partial-output)) - (err-msg (bindat-get-field res 'msg))) + (let* ((res (gdb-mi--partial-output)) + (err-msg (gdb-mi--field res 'msg))) (if (not err-msg) - (let ((memory (bindat-get-field res 'memory))) + (let ((memory (gdb-mi--field res 'memory))) (when gdb-memory-last-address ;; Nil means last retrieve emits error or just started the session. (setq gdb--memory-display-warning nil)) - (setq gdb-memory-address (bindat-get-field res 'addr)) - (setq gdb-memory-next-page (bindat-get-field res 'next-page)) - (setq gdb-memory-prev-page (bindat-get-field res 'prev-page)) + (setq gdb-memory-address (gdb-mi--field res 'addr)) + (setq gdb-memory-next-page (gdb-mi--field res 'next-page)) + (setq gdb-memory-prev-page (gdb-mi--field res 'prev-page)) (setq gdb-memory-last-address gdb-memory-address) (dolist (row memory) - (insert (concat (bindat-get-field row 'addr) ":")) - (dolist (column (bindat-get-field row 'data)) + (insert (concat (gdb-mi--field row 'addr) ":")) + (dolist (column (gdb-mi--field row 'data)) (insert (gdb-pad-string column (+ 2 (gdb-memory-column-width gdb-memory-unit @@ -3944,8 +3966,8 @@ DOC is an optional documentation string." (def-gdb-auto-update-trigger gdb-invalidate-disassembly (let* ((frame (gdb-current-buffer-frame)) - (file (bindat-get-field frame 'fullname)) - (line (bindat-get-field frame 'line))) + (file (gdb-mi--field frame 'fullname)) + (line (gdb-mi--field frame 'line))) (if file (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line) ;; If we're unable to get a file name / line for $PC, simply @@ -4001,22 +4023,22 @@ DOC is an optional documentation string." 'gdb-invalidate-disassembly) (defun gdb-disassembly-handler-custom () - (let* ((instructions (bindat-get-field (gdb-json-partial-output) 'asm_insns)) - (address (bindat-get-field (gdb-current-buffer-frame) 'addr)) + (let* ((instructions (gdb-mi--field (gdb-mi--partial-output) 'asm_insns)) + (address (gdb-mi--field (gdb-current-buffer-frame) 'addr)) (table (make-gdb-table)) (marked-line nil)) (dolist (instr instructions) (gdb-table-add-row table (list - (bindat-get-field instr 'address) + (gdb-mi--field instr 'address) (let - ((func-name (bindat-get-field instr 'func-name)) - (offset (bindat-get-field instr 'offset))) + ((func-name (gdb-mi--field instr 'func-name)) + (offset (gdb-mi--field instr 'offset))) (if func-name (format "<%s+%s>:" func-name offset) "")) - (bindat-get-field instr 'inst))) - (when (string-equal (bindat-get-field instr 'address) + (gdb-mi--field instr 'inst))) + (when (string-equal (gdb-mi--field instr 'address) address) (progn (setq marked-line (length (gdb-table-rows table))) @@ -4035,15 +4057,15 @@ DOC is an optional documentation string." (setq mode-name (gdb-current-context-mode-name (concat "Disassembly: " - (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + (gdb-mi--field (gdb-current-buffer-frame) 'func)))))) (defun gdb-disassembly-place-breakpoints () (gdb-remove-breakpoint-icons (point-min) (point-max)) (dolist (breakpoint gdb-breakpoints-list) (let* ((breakpoint (cdr breakpoint)) - (bptno (bindat-get-field breakpoint 'number)) - (flag (bindat-get-field breakpoint 'enabled)) - (address (bindat-get-field breakpoint 'addr))) + (bptno (gdb-mi--field breakpoint 'number)) + (flag (gdb-mi--field breakpoint 'enabled)) + (address (gdb-mi--field breakpoint 'addr))) (save-excursion (goto-char (point-min)) (if (re-search-forward (concat "^" address) nil t) @@ -4073,10 +4095,10 @@ DOC is an optional documentation string." (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint (gud-basic-call - (concat (if (equal "y" (bindat-get-field breakpoint 'enabled)) + (concat (if (equal "y" (gdb-mi--field breakpoint 'enabled)) "-break-disable " "-break-enable ") - (bindat-get-field breakpoint 'number))) + (gdb-mi--field breakpoint 'number))) (error "Not recognized as break/watchpoint line"))))) (defun gdb-delete-breakpoint () @@ -4087,7 +4109,7 @@ DOC is an optional documentation string." (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint (gud-basic-call (concat "-break-delete " - (bindat-get-field breakpoint 'number))) + (gdb-mi--field breakpoint 'number))) (error "Not recognized as break/watchpoint line"))))) (defun gdb-goto-breakpoint (&optional event) @@ -4101,9 +4123,9 @@ DOC is an optional documentation string." (beginning-of-line) (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint - (let ((bptno (bindat-get-field breakpoint 'number)) - (file (bindat-get-field breakpoint 'fullname)) - (line (bindat-get-field breakpoint 'line))) + (let ((bptno (gdb-mi--field breakpoint 'number)) + (file (gdb-mi--field breakpoint 'fullname)) + (line (gdb-mi--field breakpoint 'line))) (save-selected-window (let* ((buffer (find-file-noselect (if (file-exists-p file) file @@ -4134,28 +4156,28 @@ DOC is an optional documentation string." FRAME must have either \"file\" and \"line\" members or \"from\" member." - (let ((file (bindat-get-field frame 'file)) - (line (bindat-get-field frame 'line)) - (from (bindat-get-field frame 'from))) + (let ((file (gdb-mi--field frame 'file)) + (line (gdb-mi--field frame 'line)) + (from (gdb-mi--field frame 'from))) (let ((res (or (and file line (concat file ":" line)) from))) (if res (concat " of " res) "")))) (defun gdb-stack-list-frames-custom () - (let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack)) + (let ((stack (gdb-mi--field (gdb-mi--partial-output 'frame) 'stack)) (table (make-gdb-table))) (set-marker gdb-stack-position nil) (dolist (frame stack) (gdb-table-add-row table (list - (bindat-get-field frame 'level) + (gdb-mi--field frame 'level) "in" (concat - (bindat-get-field frame 'func) + (gdb-mi--field frame 'func) (if gdb-stack-buffer-locations (gdb-frame-location frame) "") (if gdb-stack-buffer-addresses - (concat " at " (bindat-get-field frame 'addr)) ""))) + (concat " at " (gdb-mi--field frame 'addr)) ""))) `(mouse-face highlight help-echo "mouse-2, RET: Select frame" gdb-frame ,frame))) @@ -4215,7 +4237,7 @@ member." (let ((frame (get-text-property (point) 'gdb-frame))) (if frame (if (gdb-buffer-shows-main-thread-p) - (let ((new-level (bindat-get-field frame 'level))) + (let ((new-level (gdb-mi--field frame 'level))) (setq gdb-frame-number new-level) (gdb-input (concat "-stack-select-frame " new-level) 'ignore) @@ -4261,7 +4283,7 @@ member." (save-excursion (if event (posn-set-point (event-end event))) (beginning-of-line) - (let* ((var (bindat-get-field + (let* ((var (gdb-mi--field (get-text-property (point) 'gdb-local-variable) 'name)) (value (read-string (format "New value (%s): " var)))) (gud-basic-call @@ -4270,12 +4292,12 @@ member." ;; Don't display values of arrays or structures. ;; These can be expanded using gud-watch. (defun gdb-locals-handler-custom () - (let ((locals-list (bindat-get-field (gdb-json-partial-output) 'locals)) + (let ((locals-list (gdb-mi--field (gdb-mi--partial-output) 'locals)) (table (make-gdb-table))) (dolist (local locals-list) - (let ((name (bindat-get-field local 'name)) - (value (bindat-get-field local 'value)) - (type (bindat-get-field local 'type))) + (let ((name (gdb-mi--field local 'name)) + (value (gdb-mi--field local 'value)) + (type (gdb-mi--field local 'type))) (when (not value) (setq value "<complex data type>")) (if (or (not value) @@ -4301,7 +4323,7 @@ member." (setq mode-name (gdb-current-context-mode-name (concat "Locals: " - (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + (gdb-mi--field (gdb-current-buffer-frame) 'func)))))) (defvar gdb-locals-header (list @@ -4367,11 +4389,11 @@ member." (defun gdb-registers-handler-custom () (when gdb-register-names (let ((register-values - (bindat-get-field (gdb-json-partial-output) 'register-values)) + (gdb-mi--field (gdb-mi--partial-output) 'register-values)) (table (make-gdb-table))) (dolist (register register-values) - (let* ((register-number (bindat-get-field register 'number)) - (value (bindat-get-field register 'value)) + (let* ((register-number (gdb-mi--field register 'number)) + (value (gdb-mi--field register 'value)) (register-name (nth (string-to-number register-number) gdb-register-names))) (gdb-table-add-row @@ -4457,7 +4479,7 @@ member." (defun gdb-changed-registers-handler () (setq gdb-changed-registers nil) (dolist (register-number - (bindat-get-field (gdb-json-partial-output) 'changed-registers)) + (gdb-mi--field (gdb-mi--partial-output) 'changed-registers)) (push register-number gdb-changed-registers))) (defun gdb-register-names-handler () @@ -4465,7 +4487,7 @@ member." ;; only once (in gdb-init-1) (setq gdb-register-names nil) (dolist (register-name - (bindat-get-field (gdb-json-partial-output) 'register-names)) + (gdb-mi--field (gdb-mi--partial-output) 'register-names)) (push register-name gdb-register-names)) (setq gdb-register-names (reverse gdb-register-names))) @@ -4476,7 +4498,8 @@ If buffers already exist for any of these files, `gud-minor-mode' is set in them." (goto-char (point-min)) (while (re-search-forward gdb-source-file-regexp nil t) - (push (read (match-string 1)) gdb-source-file-list)) + (push (gdb-mi--c-string-from-string (match-string 1)) + gdb-source-file-list)) (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (member buffer-file-name gdb-source-file-list) @@ -4492,13 +4515,13 @@ Called from `gdb-update'." (defun gdb-frame-handler () "Set `gdb-selected-frame' and `gdb-selected-file' to show overlay arrow in source buffer." - (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame))) + (let ((frame (gdb-mi--field (gdb-mi--partial-output) 'frame))) (when frame - (setq gdb-selected-frame (bindat-get-field frame 'func)) - (setq gdb-selected-file (bindat-get-field frame 'fullname)) - (setq gdb-frame-number (bindat-get-field frame 'level)) - (setq gdb-frame-address (bindat-get-field frame 'addr)) - (let ((line (bindat-get-field frame 'line))) + (setq gdb-selected-frame (gdb-mi--field frame 'func)) + (setq gdb-selected-file (gdb-mi--field frame 'fullname)) + (setq gdb-frame-number (gdb-mi--field frame 'level)) + (setq gdb-frame-address (gdb-mi--field frame 'addr)) + (let ((line (gdb-mi--field frame 'line))) (setq gdb-selected-line (and line (string-to-number line))) (when (and gdb-selected-file gdb-selected-line) (setq gud-last-frame (cons gdb-selected-file gdb-selected-line)) @@ -4523,7 +4546,7 @@ overlay arrow in source buffer." (goto-char (point-min)) (setq gdb-prompt-name nil) (re-search-forward gdb-prompt-name-regexp nil t) - (setq gdb-prompt-name (read (match-string 1))) + (setq gdb-prompt-name (gdb-mi--c-string-from-string (match-string 1))) ;; Insert first prompt. (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) @@ -4560,17 +4583,17 @@ SPLIT-HORIZONTAL and show BUF in the new window." (let* ((buf-type (gdb-buffer-type buf)) (existing-window (get-window-with-predicate - #'(lambda (w) - (and (eq buf-type - (gdb-buffer-type (window-buffer w))) - (not (window-dedicated-p w))))))) + (lambda (w) + (and (eq buf-type + (gdb-buffer-type (window-buffer w))) + (not (window-dedicated-p w))))))) (if existing-window (set-window-buffer existing-window buf) (let ((dedicated-window (get-window-with-predicate - #'(lambda (w) - (eq buf-type - (gdb-buffer-type (window-buffer w))))))) + (lambda (w) + (eq buf-type + (gdb-buffer-type (window-buffer w))))))) (if dedicated-window (set-window-buffer (split-window dedicated-window nil split-horizontal) buf) @@ -4635,7 +4658,7 @@ SPLIT-HORIZONTAL and show BUF in the new window." (let ((menu (make-sparse-keymap "GDB-MI"))) (define-key menu [gdb-customize] - '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb)) + `(menu-item "Customize" ,(lambda () (interactive) (customize-group 'gdb)) :help "Customize Gdb Graphical Mode options.")) (define-key menu [gdb-many-windows] '(menu-item "Display Other Windows" gdb-many-windows @@ -4644,26 +4667,26 @@ SPLIT-HORIZONTAL and show BUF in the new window." (define-key menu [sep1] '(menu-item "--")) (define-key menu [all-threads] - '(menu-item "GUD controls all threads" - (lambda () - (interactive) - (setq gdb-gud-control-all-threads t)) + `(menu-item "GUD controls all threads" + ,(lambda () + (interactive) + (setq gdb-gud-control-all-threads t)) :help "GUD start/stop commands apply to all threads" :button (:radio . gdb-gud-control-all-threads))) (define-key menu [current-thread] - '(menu-item "GUD controls current thread" - (lambda () - (interactive) - (setq gdb-gud-control-all-threads nil)) + `(menu-item "GUD controls current thread" + ,(lambda () + (interactive) + (setq gdb-gud-control-all-threads nil)) :help "GUD start/stop commands apply to current thread only" :button (:radio . (not gdb-gud-control-all-threads)))) (define-key menu [sep2] '(menu-item "--")) (define-key menu [gdb-customize-reasons] - '(menu-item "Customize switching..." - (lambda () - (interactive) - (customize-option 'gdb-switch-reasons)))) + `(menu-item "Customize switching..." + ,(lambda () + (interactive) + (customize-option 'gdb-switch-reasons)))) (define-key menu [gdb-switch-when-another-stopped] (menu-bar-make-toggle-command gdb-toggle-switch-when-another-stopped @@ -4972,7 +4995,7 @@ buffers, if required." ;; This function is called only once on startup. (goto-char (point-min)) (if (re-search-forward gdb-source-file-regexp nil t) - (setq gdb-main-file (read (match-string 1)))) + (setq gdb-main-file (gdb-mi--c-string-from-string (match-string 1)))) (if gdb-many-windows (gdb-setup-windows) (gdb-get-buffer-create 'gdb-breakpoints-buffer) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 625e08e4d79..2ad66ccc5e0 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -264,7 +264,10 @@ This has effect only if `search-invisible' is set to `open'." (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) - (js-mode "{" "}" "/[*/]" nil))) + (js-mode "{" "}" "/[*/]" nil) + (mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil) + ;; Add more support here. + )) "Alist for initializing the hideshow variables for different modes. Each element has the form (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 01cc330dc2e..ac3d0817097 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -1721,7 +1721,9 @@ matched in a rule action." (while (progn (skip-chars-forward makefile-dependency-skip bound) (< (point) (or bound (point-max)))) (forward-char) - (or (eq (char-after) ?=) + ;; The GNU immediate assignment operator is ":=", while the + ;; POSIX operator is "::=". + (or (looking-at ":?=") (get-text-property (1- (point)) 'face) (if (> (line-beginning-position) (+ (point-min) 2)) (eq (char-before (line-end-position 0)) ?\\)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 7f4d2251fd8..53b654001e3 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -135,7 +135,7 @@ ;; values enable completion for both CPython and IPython, and probably ;; any readline based shell (it's known to work with PyPy). If your ;; Python installation lacks readline (like CPython for Windows), -;; installing pyreadline (URL `http://ipython.org/pyreadline.html') +;; installing pyreadline (URL `https://ipython.org/pyreadline.html') ;; should suffice. To troubleshoot why you are not getting any ;; completions, you can try the following in your Python shell: @@ -3139,9 +3139,16 @@ the python shell: 4. Wraps indented regions under an \"if True:\" block so the interpreter evaluates them correctly." (let* ((start (save-excursion - ;; Normalize start to the line beginning position. + ;; If we're at the start of the expression, and + ;; there's just blank space ahead of it, then expand + ;; the region to include the start of the line. + ;; This makes things work better with the rest of + ;; the data we're sending over. (goto-char start) - (line-beginning-position))) + (if (string-blank-p + (buffer-substring (line-beginning-position) start)) + (line-beginning-position) + start))) (substring (buffer-substring-no-properties start end)) (starts-at-point-min-p (save-restriction (widen) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index bfef2a663a0..6b0df2d700d 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -232,9 +232,6 @@ (require 'cl-lib) (require 'comint) -;; Need the following to allow GNU Emacs 19 to compile the file. -(eval-when-compile - (require 'regexp-opt)) (require 'custom) (require 'thingatpt) (require 'view) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 717008a0a22..d4d51e8b50c 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -407,10 +407,64 @@ This variable is generally set from `tcl-proc-regexp', `tcl-typeword-list', and `tcl-keyword-list' by the function `tcl-set-font-lock-keywords'.") +(eval-and-compile + (defconst tcl--word-delimiters "[;{ \t\n")) + +(defun tcl--syntax-of-quote (pos) + "Decide whether a double quote opens a string or not." + ;; This is pretty tricky, because strings can be written as "..." + ;; or as {...} or without any quoting at all for some simple and not so + ;; simple cases (e.g. `abc' but also `a"b'). To make things more + ;; interesting, code is represented as strings, so the content of + ;; strings can be later re-lexed to find nested strings. + (save-excursion + (let ((ppss (syntax-ppss pos))) + (cond + ((nth 8 ppss) nil) ;; Within a string or a comment. + ((not (memq (char-before pos) + (cons nil + (eval-when-compile + (mapcar #'identity tcl--word-delimiters))))) + ;; The double quote appears within some other lexical entity. + ;; FIXME: Similar treatment should be used for `{' which can appear + ;; within non-delimited strings (but only at top-level, so + ;; maybe it's not worth worrying about). + (string-to-syntax ".")) + ((zerop (nth 0 ppss)) + ;; Not within a { ... }, so can't be truncated by a }. + ;; FIXME: The syntax-table also considers () and [] as paren + ;; delimiters just like {}, even though Tcl treats them differently. + ;; Tho I'm not sure it's worth worrying about, either. + nil) + (t + ;; A double quote within a {...}: leave it as a normal string + ;; delimiter only if we don't find a closing } before we + ;; find a closing ". + (let ((type nil) + (depth 0)) + (forward-char 1) + (while (and (not type) + (re-search-forward "[\"{}\\]" nil t)) + (pcase (char-after (match-beginning 0)) + (?\\ (forward-char 1)) + (?\" (setq type 'matched)) + (?\{ (cl-incf depth)) + (?\} (if (zerop depth) (setq type 'unmatched) + (cl-incf depth))))) + (when (> (line-beginning-position) pos) + ;; The quote is not on the same line as the deciding + ;; factor, so make sure we revisit this choice later. + (put-text-property pos (point) 'syntax-multiline t)) + (when (eq type 'unmatched) + ;; The quote has no matching close because a } closes the + ;; surrounding string before, so it doesn't really "open a string". + (string-to-syntax ".")))))))) + (defconst tcl-syntax-propertize-function (syntax-propertize-rules ;; Mark the few `#' that are not comment-markers. - ("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) + ((concat "[^" tcl--word-delimiters "][ \t]*\\(#\\)") (1 ".")) + ("\"" (0 (tcl--syntax-of-quote (match-beginning 0))))) "Syntactic keywords for `tcl-mode'.") ;; FIXME need some way to recognize variables because array refs look @@ -593,6 +647,8 @@ already exist." '(tcl-font-lock-keywords nil nil nil beginning-of-defun)) (set (make-local-variable '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) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index de2053c3c99..a1c4c08c263 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1325,7 +1325,7 @@ FILES must be a list of absolute file names." ;; call-process-region *is* measurably faster, even for a program ;; doing some actual work (for a period of time). Even though ;; call-process-region also creates a temp file internally - ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). + ;; (https://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). (if (not (file-remote-p default-directory)) (apply #'call-process-region start end program nil buffer display args) diff --git a/lisp/reposition.el b/lisp/reposition.el index 4788e6ee81e..7561cc4c5f3 100644 --- a/lisp/reposition.el +++ b/lisp/reposition.el @@ -1,4 +1,4 @@ -;;; reposition.el --- center a Lisp function or comment on the screen +;;; reposition.el --- center a Lisp function or comment on the screen -*- lexical-binding: t -*- ;; Copyright (C) 1991, 1994, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/simple.el b/lisp/simple.el index a29f85b3c36..d871be104cf 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1134,7 +1134,11 @@ is supplied, or Transient Mark mode is enabled and the mark is active." ;; If the end of the buffer is not already on the screen, ;; then scroll specially to put it near, but not at, the bottom. (overlay-recenter (point)) - (recenter -3)))) + ;; FIXME: Arguably if `scroll-conservatively' is set, then + ;; we should pass -1 to `recenter'. + (recenter (if (and scroll-minibuffer-conservatively + (window-minibuffer-p)) + -1 -3))))) (defcustom delete-active-region t "Whether single-char deletion commands delete an active region. @@ -1291,11 +1295,11 @@ that uses or sets the mark." ""))) ;; Read the argument, offering that number (if any) as default. (list (read-number (format "Goto%s line%s: " - (if (= (point-min) 1) "" - ;; In a narrowed buffer. - (if relative " relative" " absolute")) + (if (buffer-narrowed-p) + (if relative " relative" " absolute") + "") buffer-prompt) - (list default (if (or relative (= (point-min) 1)) + (list default (if (or relative (not (buffer-narrowed-p))) (line-number-at-pos) (save-restriction (widen) @@ -8014,6 +8018,7 @@ The function should return non-nil if the two tokens do not match.") (blinkpos (save-excursion (save-restriction + (syntax-propertize (point)) (if blink-matching-paren-distance (narrow-to-region (max (minibuffer-prompt-end) ;(point-min) unless minibuf. @@ -8024,7 +8029,6 @@ The function should return non-nil if the two tokens do not match.") (not blink-matching-paren-dont-ignore-comments)))) (condition-case () (progn - (syntax-propertize (point)) (forward-sexp -1) ;; backward-sexp skips backward over prefix chars, ;; so move back to the matching paren. diff --git a/lisp/skeleton.el b/lisp/skeleton.el index ea4e5dbc227..6e2c10d9711 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -339,7 +339,8 @@ automatically, and you are prompted to fill in the variable parts."))) (dlet ((str (or str `(setq str (skeleton-read ',(car skeleton-il) - nil ,recursive))))) + nil ,recursive)))) + resume:) (when (and (eq (cadr skeleton-il) '\n) (not recursive) (save-excursion (skip-chars-backward " \t") (bolp))) (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 9c5f028e4ab..991c8a33d46 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -899,12 +899,9 @@ This basically creates a sparse keymap, and makes its parent be "Additional menu items while in file-mode.") (defvar speedbar-easymenu-definition-trailer - (append - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - (list ["Customize..." speedbar-customize t])) - (list + '(["Customize..." speedbar-customize t] ["Close" dframe-close-frame t] - ["Quit" delete-frame t] )) + ["Quit" delete-frame t]) "Menu items appearing at the end of the speedbar menu.") (defvar speedbar-desired-buffer nil diff --git a/lisp/term.el b/lisp/term.el index ff8b3f00f34..8cbbfff1b63 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2805,7 +2805,7 @@ See `term-prompt-regexp'." ;; References: ;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html -;; [ECMA-48]: http://www.ecma-international.org/publications/standards/Ecma-048.htm +;; [ECMA-48]: https://www.ecma-international.org/publications/standards/Ecma-048.htm ;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html (defconst term-control-seq-regexp diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el index 674c33b45c1..8ce7fbbcafd 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -1,4 +1,4 @@ -;;; AT386.el --- terminal support package for IBM AT keyboards +;;; AT386.el --- terminal support package for IBM AT keyboards -*- lexical-binding: t -*- ;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/internal.el b/lisp/term/internal.el index c54481a5327..9a6f4fac1ee 100644 --- a/lisp/term/internal.el +++ b/lisp/term/internal.el @@ -1,4 +1,4 @@ -;;; internal.el --- support for PC internal terminal +;;; internal.el --- support for PC internal terminal -*- lexical-binding: t -*- ;; Copyright (C) 1993-1994, 1998-1999, 2001-2020 Free Software ;; Foundation, Inc. diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el index 8a99ddf8c0d..7a92aa7adaa 100644 --- a/lisp/term/iris-ansi.el +++ b/lisp/term/iris-ansi.el @@ -1,4 +1,4 @@ -;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps +;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps -*- lexical-binding: t -*- ;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el index aab4110b3ae..3bcaa2ecd18 100644 --- a/lisp/term/lk201.el +++ b/lisp/term/lk201.el @@ -1,4 +1,4 @@ -;; Define function key sequences for DEC terminals. +;; Define function key sequences for DEC terminals. -*- lexical-binding: t -*- (defvar lk201-function-map (let ((map (make-sparse-keymap))) diff --git a/lisp/term/news.el b/lisp/term/news.el index e01d6f64be3..33c7aa6ccaa 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -1,4 +1,4 @@ -;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard +;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard -*- lexical-binding: t -*- ;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el index 31e3d6ede4f..71ee9086937 100644 --- a/lisp/term/rxvt.el +++ b/lisp/term/rxvt.el @@ -1,4 +1,4 @@ -;;; rxvt.el --- define function key sequences and standard colors for rxvt +;;; rxvt.el --- define function key sequences and standard colors for rxvt -*- lexical-binding: t -*- ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. diff --git a/lisp/term/sun.el b/lisp/term/sun.el index 41915e1b07c..7d1cd9f2cfe 100644 --- a/lisp/term/sun.el +++ b/lisp/term/sun.el @@ -1,4 +1,4 @@ -;;; sun.el --- keybinding for standard default sunterm keys +;;; sun.el --- keybinding for standard default sunterm keys -*- lexical-binding: t -*- ;; Copyright (C) 1987, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index c0e6a12b735..fc8ad80ae5c 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -1,4 +1,4 @@ -;;; tvi970.el --- terminal support for the Televideo 970 +;;; tvi970.el --- terminal support for the Televideo 970 -*- lexical-binding: t -*- ;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el index 9e9fc4dd7de..6d72d4a05b6 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -1,4 +1,4 @@ -;;; wyse50.el --- terminal support code for Wyse 50 +;;; wyse50.el --- terminal support code for Wyse 50 -*- lexical-binding: t -*- ;; Copyright (C) 1989, 1993-1994, 2001-2020 Free Software Foundation, ;; Inc. diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 910bd7dbb9d..715379fa80f 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -85,8 +85,8 @@ If this is a function, call it to generate the initial field text." :type '(choice (const :tag "None" nil) (string :tag "Initial text") (function :tag "Initialize Function") - (const :tag "Default" t))) -(put 'bibtex-include-OPTkey 'risky-local-variable t) + (const :tag "Default" t)) + :risky t) (defcustom bibtex-user-optional-fields '(("annote" "Personal annotation (ignored)")) @@ -97,8 +97,8 @@ in `bibtex-BibTeX-entry-alist' (which see)." :type '(repeat (group (string :tag "Field") (string :tag "Comment") (option (choice :tag "Init" - (const nil) string function))))) -(put 'bibtex-user-optional-fields 'risky-local-variable t) + (const nil) string function)))) + :risky t) (defcustom bibtex-entry-format '(opts-or-alts required-fields numerical-fields) @@ -148,20 +148,18 @@ The value nil means do no formatting at all." (const unify-case) (const braces) (const strings) - (const sort-fields)))) -(put 'bibtex-entry-format 'safe-local-variable - (lambda (x) - (or (eq x t) - (let ((OK t)) - (while (consp x) - (unless (memq (pop x) - '(opts-or-alts required-fields numerical-fields - page-dashes whitespace inherit-booktitle realign - last-comma delimiters unify-case braces strings - sort-fields)) - (setq OK nil))) - (unless (null x) (setq OK nil)) - OK)))) + (const sort-fields))) + :safe (lambda (x) + (or (eq x t) + (let ((ok t)) + (while (consp x) + (unless (memq (pop x) + '( opts-or-alts required-fields numerical-fields + page-dashes whitespace inherit-booktitle + realign last-comma delimiters unify-case + braces strings sort-fields )) + (setq ok nil))) + (unless x ok))))) (defcustom bibtex-field-braces-alist nil "Alist of field regexps that \\[bibtex-clean-entry] encloses by braces. @@ -207,9 +205,8 @@ See also `bibtex-sort-ignore-string-entries'." (const plain) (const crossref) (const entry-class) - (const t))) -(put 'bibtex-maintain-sorted-entries 'safe-local-variable - (lambda (a) (memq a '(nil t plain crossref entry-class)))) + (const t)) + :safe (lambda (a) (memq a '(nil t plain crossref entry-class)))) (defcustom bibtex-sort-entry-class '(("String") @@ -223,18 +220,17 @@ to all entries not explicitly mentioned." :group 'bibtex :type '(repeat (choice :tag "Class" (const :tag "catch-all" (catch-all)) - (repeat :tag "Entry type" string)))) -(put 'bibtex-sort-entry-class 'safe-local-variable - (lambda (x) (let ((OK t)) - (while (consp x) - (let ((y (pop x))) - (while (consp y) - (let ((z (pop y))) - (unless (or (stringp z) (eq z 'catch-all)) - (setq OK nil)))) - (unless (null y) (setq OK nil)))) - (unless (null x) (setq OK nil)) - OK))) + (repeat :tag "Entry type" string))) + :safe (lambda (x) + (let ((ok t)) + (while (consp x) + (let ((y (pop x))) + (while (consp y) + (let ((z (pop y))) + (unless (or (stringp z) (eq z 'catch-all)) + (setq ok nil)))) + (when y (setq ok nil)))) + (unless x ok)))) (defcustom bibtex-sort-ignore-string-entries t "If non-nil, BibTeX @String entries are not sort-significant. @@ -459,8 +455,8 @@ ALTERNATIVE if non-nil is an integer that numbers sets of alternatives, starting from zero." :group 'bibtex :version "26.1" ; add Conference - :type 'bibtex-entry-alist) -(put 'bibtex-BibTeX-entry-alist 'risky-local-variable t) + :type 'bibtex-entry-alist + :risky t) (defcustom bibtex-biblatex-entry-alist ;; Compare in biblatex documentation: @@ -714,8 +710,8 @@ alternatives, starting from zero." It has the same format as `bibtex-BibTeX-entry-alist'." :group 'bibtex :version "24.1" - :type 'bibtex-entry-alist) -(put 'bibtex-biblatex-entry-alist 'risky-local-variable t) + :type 'bibtex-entry-alist + :risky t) (define-widget 'bibtex-field-alist 'lazy "Format of `bibtex-BibTeX-entry-alist' and friends." @@ -857,8 +853,8 @@ To interactively change the dialect use the command `bibtex-set-dialect'." (bibtex-set-dialect value))) :type '(choice (const BibTeX) (const biblatex) - (symbol :tag "Custom"))) -(put 'bibtex-dialect 'safe-local-variable 'symbolp) + (symbol :tag "Custom")) + :safe #'symbolp) (defcustom bibtex-no-opt-remove-re "\\`option" "If a field name matches this regexp, the prefix OPT is not removed. @@ -1059,9 +1055,8 @@ See `bibtex-generate-autokey' for details." (const :tag "Downcase" downcase) (const :tag "Capitalize" capitalize) (const :tag "Upcase" upcase) - (function :tag "Conversion function"))) -(put 'bibtex-autokey-name-case-convert-function 'safe-local-variable - (lambda (x) (memq x '(upcase downcase capitalize identity)))) + (function :tag "Conversion function" :value identity)) + :safe (lambda (x) (memq x '(upcase downcase capitalize identity)))) (defcustom bibtex-autokey-name-length 'infty "Number of characters from name to incorporate into key. @@ -1313,8 +1308,8 @@ The following is a complex example, see URL `http://link.aps.org/'. (regexp :tag "Regexp") (choice (string :tag "Replacement") (integer :tag "Sub-match") - (function :tag "Filter")))))))) -(put 'bibtex-generate-url-list 'risky-local-variable t) + (function :tag "Filter"))))))) + :risky t) (defcustom bibtex-cite-matcher-alist '(("\\\\cite[ \t\n]*{\\([^}]+\\)}" . 1)) @@ -1536,21 +1531,19 @@ At most `bibtex-entry-kill-ring-max' items are kept here.") (defvar bibtex-last-kill-command nil "Type of the last kill command (either `field' or `entry').") -(defvar bibtex-strings +(defvar-local bibtex-strings (lazy-completion-table bibtex-strings (lambda () (bibtex-parse-strings (bibtex-string-files-init)))) "Completion table for BibTeX string keys. Initialized from `bibtex-predefined-strings' and `bibtex-string-files'.") -(make-variable-buffer-local 'bibtex-strings) (put 'bibtex-strings 'risky-local-variable t) -(defvar bibtex-reference-keys +(defvar-local bibtex-reference-keys (lazy-completion-table bibtex-reference-keys (lambda () (bibtex-parse-keys nil t))) "Completion table for BibTeX reference keys. The CDRs of the elements are t for header keys and nil for crossref keys.") -(make-variable-buffer-local 'bibtex-reference-keys) (put 'bibtex-reference-keys 'risky-local-variable t) (defvar bibtex-buffer-last-parsed-tick nil diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 0d1eeed5611..747657b1ed5 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1357,7 +1357,9 @@ the string PROPERTY." (defun css--complete-property-value () "Complete property value at point." (let ((property (and (looking-back "\\([[:alnum:]-]+\\):[^/][^;]*" - (line-beginning-position) t) + (or (ppss-innermost-start (syntax-ppss)) + (point)) + t) (member (match-string-no-properties 1) css-property-ids)))) (when property diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el index 54e20779bdc..329f3e7241d 100644 --- a/lisp/textmodes/mhtml-mode.el +++ b/lisp/textmodes/mhtml-mode.el @@ -22,6 +22,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'pcase)) (require 'sgml-mode) (require 'js) (require 'css-mode) @@ -303,6 +304,17 @@ This is used by `mhtml--pre-command'.") (flyspell-generic-progmode-verify) t))) +;; Support for hideshow.el (see `hs-special-modes-alist'). +(defun mhtml-forward (arg) + "Move point forward past a structured expression. +If point is on a tag, move to the end of the tag. +Otherwise, this calls `forward-sexp'. +Prefix arg specifies how many times to move (default 1)." + (interactive "P") + (pcase (get-text-property (point) 'mhtml-submode) + ('nil (sgml-skip-tag-forward arg)) + (submode (forward-sexp arg)))) + ;;;###autoload (define-derived-mode mhtml-mode html-mode '((sgml-xml-mode "XHTML+" "HTML+") (:eval (mhtml--submode-lighter))) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index f2fcd62c871..adda28cb81b 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -2862,7 +2862,7 @@ file-write hook to always make it up-to-date automatically." ;; FIXME: Updating the toc on saving would be nice. However, this doesn't work ;; correctly: ;; -;; (add-hook 'write-contents-hooks 'rst-toc-update-fun) +;; (add-hook 'write-contents-functions 'rst-toc-update-fun) ;; (defun rst-toc-update-fun () ;; ;; Disable undo for the write file hook. ;; (let ((buffer-undo-list t)) (rst-toc-update) )) diff --git a/lisp/time.el b/lisp/time.el index 63773d42048..eca9a0752e4 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -531,6 +531,9 @@ See `world-clock'." (setq-local revert-buffer-function #'world-clock-update) (setq show-trailing-whitespace nil)) +(defvar world-clock--timer nil + "The current world clock timer.") + (defun world-clock-display (alist) "Replace current buffer text with times in various zones, based on ALIST." (let ((inhibit-read-only t) @@ -571,7 +574,8 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. (pop-to-buffer buffer) (pop-to-buffer world-clock-buffer-name) (when world-clock-timer-enable - (run-at-time t world-clock-timer-second #'world-clock-update) + (setq world-clock--timer + (run-at-time t world-clock-timer-second #'world-clock-update)) (add-hook 'kill-buffer-hook #'world-clock-cancel-timer nil t))) (world-clock-display (time--display-world-list)) (world-clock-mode) @@ -579,12 +583,9 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. (defun world-clock-cancel-timer () "Cancel the world clock timer." - (let ((list timer-list)) - (while list - (let ((elt (pop list))) - (when (equal (symbol-name (timer--function elt)) - "world-clock-update") - (cancel-timer elt)))))) + (when world-clock--timer + (cancel-timer world-clock--timer) + (setq world-clock--timer nil))) (defun world-clock-update (&optional _arg _noconfirm) "Update the `world-clock' buffer." diff --git a/lisp/tmm.el b/lisp/tmm.el index 0e83f427f5f..4c2855751c2 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -42,30 +42,7 @@ (defvar tmm-next-shortcut-digit) (defvar tmm-table-undef) -(defun tmm-menubar-keymap () - "Return the current menu-bar keymap. - -The ordering of the return value respects `menu-bar-final-items'." - (let ((menu-bar '()) - (menu-end '())) - (map-keymap - (lambda (key binding) - (let ((pos (seq-position menu-bar-final-items key)) - (menu-item (cons key binding))) - (if pos - ;; If KEY is the name of an item that we want to put - ;; last, store it separately with explicit ordering for - ;; sorting. - (push (cons pos menu-item) menu-end) - (push menu-item menu-bar)))) - (tmm-get-keybind [menu-bar])) - `(keymap ,@(nreverse menu-bar) - ,@(mapcar #'cdr (sort menu-end - (lambda (a b) - (< (car a) (car b)))))))) - ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) -;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) ;;;###autoload (defun tmm-menubar (&optional x-position) @@ -79,33 +56,12 @@ to invoke `tmm-menubar' instead, customize the variable `tty-menu-open-use-tmm' to a non-nil value." (interactive) (run-hooks 'menu-bar-update-hook) - ;; Obey menu-bar-final-items; put those items last. - (let ((menu-bar (tmm-menubar-keymap)) - menu-bar-item) - (if x-position - (let ((column 0) - prev-key) - (catch 'done - (map-keymap - (lambda (key binding) - (when (> column x-position) - (setq menu-bar-item prev-key) - (throw 'done nil)) - (setq prev-key key) - (pcase binding - ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item. - `(menu-item ,name ,_cmd ;Extended menu item. - . ,(and props - (guard (let ((visible - (plist-get props :visible))) - (or (null visible) - (eval visible))))))) - (setq column (+ column (length name) 1))))) - menu-bar) - ;; Check the last menu item. - (when (> column x-position) - (setq menu-bar-item prev-key))))) - (tmm-prompt menu-bar nil menu-bar-item))) + (let ((menu-bar (menu-bar-keymap)) + (menu-bar-item-cons (and x-position + (menu-bar-item-at-x x-position)))) + (tmm-prompt menu-bar + nil + (and menu-bar-item-cons (car menu-bar-item-cons))))) ;;;###autoload (defun tmm-menubar-mouse (event) @@ -525,14 +481,6 @@ It uses the free variable `tmm-table-undef' to keep undefined keys." (or (assoc str tmm-km-list) (push (cons str (cons event km)) tmm-km-list)))))) -(defun tmm-get-keybind (keyseq) - "Return the current binding of KEYSEQ, merging prefix definitions. -If KEYSEQ is a prefix key that has local and global bindings, -we merge them into a single keymap which shows the proper order of the menu. -However, for the menu bar itself, the value does not take account -of `menu-bar-final-items'." - (lookup-key (cons 'keymap (nreverse (current-active-maps))) keyseq)) - (provide 'tmm) ;;; tmm.el ends here diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 7df1e28e06f..84562164300 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -1,4 +1,4 @@ -;;; tool-bar.el --- setting up the tool bar +;;; tool-bar.el --- setting up the tool bar -*- lexical-binding: t -*- ;; Copyright (C) 2000-2020 Free Software Foundation, Inc. @@ -139,7 +139,7 @@ ICON.xbm, using `find-image'. Use this function only to make bindings in the global value of `tool-bar-map'. To define items in any other map, use `tool-bar-local-item'." - (apply 'tool-bar-local-item icon def key tool-bar-map props)) + (apply #'tool-bar-local-item icon def key tool-bar-map props)) (defun tool-bar--image-expression (icon) "Return an expression that evaluates to an image spec for ICON." @@ -191,7 +191,7 @@ MAP must contain appropriate binding for `[menu-bar]' which holds a keymap. Use this function only to make bindings in the global value of `tool-bar-map'. To define items in any other map, use `tool-bar-local-item-from-menu'." - (apply 'tool-bar-local-item-from-menu command icon + (apply #'tool-bar-local-item-from-menu command icon (default-value 'tool-bar-map) map props)) ;;;###autoload diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 7c9ad25eb31..5aeb8feb990 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -208,6 +208,8 @@ and hunk-based syntax highlighting otherwise as a fallback." ;; `d' because it duplicates the context :-( --Stef ("\C-c\C-d" . diff-unified->context) ("\C-c\C-w" . diff-ignore-whitespace-hunk) + ;; `l' because it "refreshes" the hunk like C-l refreshes the screen + ("\C-c\C-l" . diff-refresh-hunk) ("\C-c\C-b" . diff-refine-hunk) ;No reason for `b' :-( ("\C-c\C-f" . next-error-follow-minor-mode)) "Keymap for `diff-mode'. See also `diff-mode-shared-map'.") @@ -244,6 +246,8 @@ and hunk-based syntax highlighting otherwise as a fallback." :help "Split the current (unified diff) hunk at point into two hunks"] ["Ignore whitespace changes" diff-ignore-whitespace-hunk :help "Re-diff the current hunk, ignoring whitespace differences"] + ["Recompute the hunk" diff-refresh-hunk + :help "Re-diff the current hunk, keeping the whitespace differences"] ["Highlight fine changes" diff-refine-hunk :help "Highlight changes of hunk at point at a finer granularity"] ["Kill current hunk" diff-hunk-kill @@ -2045,8 +2049,15 @@ For use in `add-log-current-defun-function'." (defun diff-ignore-whitespace-hunk () "Re-diff the current hunk, ignoring whitespace differences." (interactive) + (diff-refresh-hunk t)) + +(defun diff-refresh-hunk (&optional ignore-whitespace) + "Re-diff the current hunk." + (interactive) (let* ((char-offset (- (point) (diff-beginning-of-hunk t))) - (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b"))) + (opt-type (pcase (char-after) + (?@ "-u") + (?* "-c"))) (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") (error "Can't find line number")) (string-to-number (match-string 1)))) @@ -2057,7 +2068,12 @@ For use in `add-log-current-defun-function'." (file1 (make-temp-file "diff1")) (file2 (make-temp-file "diff2")) (coding-system-for-read buffer-file-coding-system) - old new) + opts old new) + (when ignore-whitespace + (setq opts '("-b"))) + (when opt-type + (setq opts (cons opt-type opts))) + (unwind-protect (save-excursion (setq old (diff-hunk-text hunk nil char-offset)) @@ -2066,8 +2082,9 @@ For use in `add-log-current-defun-function'." (write-region (concat lead (car new)) nil file2 nil 'nomessage) (with-temp-buffer (let ((status - (call-process diff-command nil t nil - opts file1 file2))) + (apply 'call-process + `(,diff-command nil t nil + ,@opts ,file1 ,file2)))) (pcase status (0 nil) ;Nothing to reformat. (1 (goto-char (point-min)) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index f98730ed221..e2d0ca69a20 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -26,7 +26,7 @@ ;;; Commentary: -;; See <URL:http://bazaar.canonical.com/> concerning bzr. +;; See <URL:https://bazaar.canonical.com/> concerning bzr. ;; This library provides bzr support in VC. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index b1880c0f7b0..91554bb6d83 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1573,8 +1573,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defun vc-git-extra-status-menu () vc-git-extra-menu-map) (defun vc-git-root (file) - (or (vc-file-getprop file 'git-root) - (vc-file-setprop file 'git-root (vc-find-root file ".git")))) + (vc-find-root file ".git")) ;; grep-compute-defaults autoloads grep. (declare-function grep-read-regexp "grep" ()) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index e108b3a340f..06dd09490d2 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -51,8 +51,8 @@ :group 'vc-svn) ;; Might be nice if svn defaulted to non-interactive if stdin not tty. -;; http://svn.haxx.se/dev/archive-2008-05/0762.shtml -;; http://svn.haxx.se/dev/archive-2009-04/0094.shtml +;; https://svn.haxx.se/dev/archive-2008-05/0762.shtml +;; https://svn.haxx.se/dev/archive-2009-04/0094.shtml ;; Maybe newer ones do? (defcustom vc-svn-global-switches (unless (eq system-type 'darwin) ; bug#13513 '("--non-interactive")) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 39d0fab391d..8def7da3776 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -979,12 +979,22 @@ be reported. If NO-ERROR is nil, signal an error that no VC backend is responsible for the given file." (or (and (not (file-directory-p file)) (vc-backend file)) - (catch 'found - ;; First try: find a responsible backend. If this is for registration, - ;; it must be a backend under which FILE is not yet registered. - (dolist (backend vc-handled-backends) - (and (vc-call-backend backend 'responsible-p file) - (throw 'found backend)))) + ;; First try: find a responsible backend. If this is for registration, + ;; it must be a backend under which FILE is not yet registered. + (let ((dirs (delq nil + (mapcar + (lambda (backend) + (when-let ((dir (vc-call-backend + backend 'responsible-p file))) + (cons backend dir))) + vc-handled-backends)))) + ;; Just a single response (or none); use it. + (if (< (length dirs) 2) + (caar dirs) + ;; Several roots; we seem to have one vc inside another's + ;; directory. Choose the most specific. + (caar (sort dirs (lambda (d1 d2) + (< (length (cdr d2)) (length (cdr d1)))))))) (unless no-error (error "No VC backend is responsible for %s" file)))) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 009c6b4faf2..4e2cf7416d4 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3585,7 +3585,30 @@ To use this type, you must define :match or :match-alternatives." :value-to-internal (lambda (widget value) (if (widget-apply widget :match value) (widget-sexp-value-to-internal widget value) - value))) + value)) + :value-to-external (lambda (widget value) + ;; We expect VALUE to be a string, so we can convert it + ;; into the external format just by `read'ing it. + ;; But for a restricted-sexp widget with a bad default + ;; value, we might end up calling read with a nil + ;; argument, resulting in an undesired prompt to the + ;; user. A bad default value is not always a big + ;; problem, but might end up in a messed up buffer, + ;; so display a warning here. (Bug#25152) + (unless (stringp value) + (display-warning + 'widget-bad-default-value + (format-message + "\nA widget of type %S has a bad default value. +value: %S +match function: %S +match-alternatives: %S" + (widget-type widget) + value + (widget-get widget :match) + (widget-get widget :match-alternatives)) + :warning)) + (read value))) (defun widget-restricted-sexp-match (widget value) (let ((alternatives (widget-get widget :match-alternatives)) diff --git a/lisp/window.el b/lisp/window.el index 1fcfffcb53d..865f6fdd5cc 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -3432,7 +3432,7 @@ routines." "Resize minibuffer-only frame FRAME." (if (functionp resize-mini-frames) (funcall resize-mini-frames frame) - (fit-frame-to-buffer frame))) + (fit-mini-frame-to-buffer frame))) (defun window--sanitize-window-sizes (horizontal) "Assert that all windows on selected frame are large enough. @@ -8925,6 +8925,14 @@ Return 0 otherwise." (declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise)) +(defun fit-mini-frame-to-buffer (&optional frame) + "Adjust size of minibuffer FRAME to display its contents. +FRAME should be a minibuffer-only frame and defaults to the +selected one. Unlike `fit-frame-to-buffer' FRAME will fit to the +contents of its buffer with any leading or trailing empty lines +included." + (fit-frame-to-buffer-1 frame)) + (defun fit-frame-to-buffer (&optional frame max-height min-height max-width min-width only) "Adjust size of FRAME to display the contents of its buffer exactly. FRAME can be any live frame and defaults to the selected one. @@ -8943,8 +8951,18 @@ horizontally only. The new position and size of FRAME can be additionally determined by customizing the options `fit-frame-to-buffer-sizes' and `fit-frame-to-buffer-margins' or setting the corresponding -parameters of FRAME." +parameters of FRAME. + +Any leading or trailing empty lines of the buffer content are not +considered." (interactive) + (fit-frame-to-buffer-1 frame max-height min-height max-width min-width only t t)) + +(defun fit-frame-to-buffer-1 (&optional frame max-height min-height max-width min-width only from to) + "Helper function for `fit-frame-to-buffer'. +FROM and TO are the buffer positions to determine the size to fit +to, see `window-text-pixel-size'. The remaining arguments are as +for `fit-frame-to-buffer'." (unless (fboundp 'display-monitor-attributes-list) (user-error "Cannot resize frame in non-graphic Emacs")) (setq frame (window-normalize-frame frame)) @@ -9079,7 +9097,7 @@ parameters of FRAME." ;; Note: Currently, for a new frame the sizes of the header ;; and mode line may be estimated incorrectly (size - (window-text-pixel-size window t t max-width max-height)) + (window-text-pixel-size window from to max-width max-height)) (width (max (car size) min-width)) (height (max (cdr size) min-height))) ;; Don't change height or width when the window's size is fixed diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 362d29b943d..f9c08f9a174 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -76,7 +76,11 @@ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." ;; to guard against that. (copy-sequence event)) vec) - (is-move vec) + (is-move + (if track-mouse vec + ;; Mouse movement events are currently supposed to be + ;; suppressed. Return no event. + [])) (t (let* ((down (terminal-parameter nil 'xterm-mouse-last-down)) (down-data (nth 1 down)) @@ -263,7 +267,7 @@ which is the \"1006\" extension implemented in Xterm >= 277." (eq y 1))) 'tab-bar 'menu-bar)) - (nthcdr 2 (posn-at-x-y x y))))) + (nthcdr 2 (posn-at-x-y x y (selected-frame)))))) (event (list type posn))) (setcar (nthcdr 3 posn) timestamp) @@ -321,11 +325,13 @@ down the SHIFT key while pressing the mouse button." (if xterm-mouse-mode ;; Turn it on (progn - (setq mouse-position-function #'xterm-mouse-position-function) + (setq mouse-position-function #'xterm-mouse-position-function + tty-menu-calls-mouse-position-function t) (mapc #'turn-on-xterm-mouse-tracking-on-terminal (terminal-list))) ;; Turn it off (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list)) - (setq mouse-position-function nil))) + (setq mouse-position-function nil + tty-menu-calls-mouse-position-function nil))) (defun xterm-mouse-tracking-enable-sequence () "Return a control sequence to enable XTerm mouse tracking. @@ -339,8 +345,8 @@ modern xterms: position (<= 223), which can be reported in this basic mode. -\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse - motion events during dragging operations. +\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse + motion events. \"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an extension to the basic mouse mode, which uses UTF-8 @@ -360,7 +366,7 @@ given escape sequence takes precedence over the former." (apply #'concat (xterm-mouse--tracking-sequence ?h))) (defconst xterm-mouse-tracking-enable-sequence - "\e[?1000h\e[?1002h\e[?1005h\e[?1006h" + "\e[?1000h\e[?1003h\e[?1005h\e[?1006h" "Control sequence to enable xterm mouse tracking. Enables basic mouse tracking, mouse motion events and finally extended tracking on terminals that support it. The following @@ -371,8 +377,8 @@ escape sequences are understood by modern xterms: position (<= 223), which can be reported in this basic mode. -\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse - motion events during dragging operations. +\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse + motion events. \"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an extension to the basic mouse mode, which uses UTF-8 @@ -400,7 +406,7 @@ The control sequence resets the modes set by (apply #'concat (nreverse (xterm-mouse--tracking-sequence ?l)))) (defconst xterm-mouse-tracking-disable-sequence - "\e[?1006l\e[?1005l\e[?1002l\e[?1000l" + "\e[?1006l\e[?1005l\e[?1003l\e[?1000l" "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.") (make-obsolete-variable @@ -414,7 +420,7 @@ SUFFIX is the last character of each escape sequence (?h to enable, ?l to disable)." (mapcar (lambda (code) (format "\e[?%d%c" code suffix)) - `(1000 1002 ,@(when xterm-mouse-utf-8 '(1005)) 1006))) + `(1000 1003 ,@(when xterm-mouse-utf-8 '(1005)) 1006))) (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal) "Enable xterm mouse tracking on TERMINAL." diff --git a/msdos/autogen/Makefile.in b/msdos/autogen/Makefile.in index be1a84faa66..42a4656f9d5 100644 --- a/msdos/autogen/Makefile.in +++ b/msdos/autogen/Makefile.in @@ -26,7 +26,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this file. If not, see <http://www.gnu.org/licenses/>. +# along with this file. If not, see <https://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, # this file may be distributed as part of a program that @@ -49,7 +49,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this file. If not, see <http://www.gnu.org/licenses/>. +# along with this file. If not, see <https://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, # this file may be distributed as part of a program that diff --git a/msdos/autogen/config.in b/msdos/autogen/config.in index 6101abd1fa6..6475d99d6f1 100644 --- a/msdos/autogen/config.in +++ b/msdos/autogen/config.in @@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */ +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* No code in Emacs #includes config.h twice, but some bits of code diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index c3d4dfa4c28..0a0e0330a24 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -22,7 +22,7 @@ MinGW-w64 provides a complete runtime for projects built with GCC for 64-bit Windows -- it's located at http://mingw-w64.org/. MSYS2 is a Cygwin-derived software distribution for Windows which provides -build tools for MinGW-w64 -- see http://msys2.github.io/. +build tools for MinGW-w64 -- see https://msys2.github.io/. ** Download and install MinGW-w64 and MSYS2 diff --git a/src/composite.c b/src/composite.c index 984e0d9cda8..66c1e86aae1 100644 --- a/src/composite.c +++ b/src/composite.c @@ -637,10 +637,8 @@ compose_text (ptrdiff_t start, ptrdiff_t end, Lisp_Object components, static Lisp_Object gstring_hash_table; -static Lisp_Object gstring_lookup_cache (Lisp_Object); - -static Lisp_Object -gstring_lookup_cache (Lisp_Object header) +Lisp_Object +composition_gstring_lookup_cache (Lisp_Object header) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); ptrdiff_t i = hash_lookup (h, header, NULL); @@ -679,6 +677,27 @@ composition_gstring_from_id (ptrdiff_t id) return HASH_VALUE (h, id); } +/* Remove from the composition hash table every lgstring that + references the given FONT_OBJECT. */ +void +composition_gstring_cache_clear_font (Lisp_Object font_object) +{ + struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); + + for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) + { + Lisp_Object k = HASH_KEY (h, i); + + if (!EQ (k, Qunbound)) + { + Lisp_Object gstring = HASH_VALUE (h, i); + + if (EQ (LGSTRING_FONT (gstring), font_object)) + hash_remove_from_table (h, k); + } + } +} + DEFUN ("clear-composition-cache", Fclear_composition_cache, Sclear_composition_cache, 0, 0, 0, doc: /* Internal use only. @@ -1781,7 +1800,7 @@ should be ignored. */) header = fill_gstring_header (frompos, frombyte, topos, font_object, string); - gstring = gstring_lookup_cache (header); + gstring = composition_gstring_lookup_cache (header); if (! NILP (gstring)) return gstring; diff --git a/src/composite.h b/src/composite.h index 239f1e531ef..bdf63fed10e 100644 --- a/src/composite.h +++ b/src/composite.h @@ -330,6 +330,9 @@ extern int composition_update_it (struct composition_it *, ptrdiff_t, ptrdiff_t, Lisp_Object); extern ptrdiff_t composition_adjust_point (ptrdiff_t, ptrdiff_t); +extern Lisp_Object composition_gstring_lookup_cache (Lisp_Object); + +extern void composition_gstring_cache_clear_font (Lisp_Object); INLINE_HEADER_END diff --git a/src/dbusbind.c b/src/dbusbind.c index 7904606d39e..dc4db5c8513 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -409,9 +409,12 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: - /* We dont check the syntax of object path and signature. This - will be done by libdbus. */ - CHECK_STRING (object); + /* We dont check the syntax of signature. This will be done by + libdbus. */ + if (dtype == DBUS_TYPE_OBJECT_PATH) + XD_DBUS_VALIDATE_PATH (object) + else + CHECK_STRING (object); sprintf (signature, "%c", dtype); break; @@ -732,9 +735,12 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: - /* We dont check the syntax of object path and signature. - This will be done by libdbus. */ - CHECK_STRING (object); + /* We dont check the syntax of signature. This will be done + by libdbus. */ + if (dtype == DBUS_TYPE_OBJECT_PATH) + XD_DBUS_VALIDATE_PATH (object) + else + CHECK_STRING (object); { /* We need to send a valid UTF-8 string. We could encode `object' but by not encoding it, we guarantee it's valid utf-8, even if diff --git a/src/doprnt.c b/src/doprnt.c index ceadf3bdfad..ce259d07cfe 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -28,6 +28,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ . For %s and %c, when field width is specified (e.g., %25s), it accounts for the display width of each character, according to char-width-table. That is, it does not assume that each character takes one column on display. + Nor does it assume that each character is a single byte. . If the size of the buffer is not enough to produce the formatted string in its entirety, it makes sure that truncation does not chop the last @@ -42,12 +43,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ Emacs can handle. OTOH, this function supports only a small subset of the standard C formatted - output facilities. E.g., %u and %ll are not supported, and precision is - ignored %s and %c conversions. (See below for the detailed documentation of - what is supported.) However, this is okay, as this function is supposed to - be called from `error' and similar functions, and thus does not need to - support features beyond those in `Fformat_message', which is used - by `error' on the Lisp level. */ + output facilities. E.g., %u is not supported, precision is ignored + in %s and %c conversions, and %lld does not necessarily work and + code should use something like %"pM"d with intmax_t instead. + (See below for the detailed documentation of what is supported.) + However, this is okay, as this function is supposed to be called + from 'error' and similar C functions, and thus does not need to + support all the features of 'Fformat_message', which is used by the + Lisp 'error' function. */ /* In the FORMAT argument this function supports ` and ' as directives that output left and right quotes as per ‘text-quoting style’. It @@ -61,19 +64,21 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ %e means print a `double' argument in exponential notation. %f means print a `double' argument in decimal-point notation. %g means print a `double' argument in exponential notation - or in decimal-point notation, whichever uses fewer characters. + or in decimal-point notation, depending on the value; + this is often (though not always) the shorter of the two notations. %c means print a `signed int' argument as a single character. %% means produce a literal % character. - A %-sequence may contain optional flag, width, and precision specifiers, and - a length modifier, as follows: + A %-sequence other than %% may contain optional flags, width, precision, + and length, as follows: %<flags><width><precision><length>character where flags is [+ -0], width is [0-9]+, precision is .[0-9]+, and length is empty or l or the value of the pD or pI or PRIdMAX (sans "d") macros. - Also, %% in a format stands for a single % in the output. A % that - does not introduce a valid %-sequence causes undefined behavior. + A % that does not introduce a valid %-sequence causes undefined behavior. + ASCII bytes in FORMAT other than % are copied through as-is; + non-ASCII bytes should not appear in FORMAT. The + flag character inserts a + before any positive number, while a space inserts a space before any positive number; these flags only affect %d, %o, @@ -99,7 +104,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ For %e, %f, and %g sequences, the number after the "." in the precision specifier says how many decimal places to show; if zero, the decimal point - itself is omitted. For %s and %S, the precision specifier is ignored. */ + itself is omitted. For %d, %o, and %x sequences, the precision specifies + the minimum number of digits to appear. Precision specifiers are + not supported for other %-sequences. */ #include <config.h> #include <stdio.h> @@ -115,7 +122,50 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ another macro. */ #include "character.h" +/* Enough to handle floating point formats with large numbers. */ +enum { SIZE_BOUND_EXTRA = DBL_MAX_10_EXP + 50 }; + +/* Parse FMT as an unsigned decimal integer, putting its value into *VALUE. + Return the address of the first byte after the integer. + If FMT is not an integer, return FMT and store zero into *VALUE. */ +static char const * +parse_format_integer (char const *fmt, int *value) +{ + int n = 0; + bool overflow = false; + for (; '0' <= *fmt && *fmt <= '9'; fmt++) + { + overflow |= INT_MULTIPLY_WRAPV (n, 10, &n); + overflow |= INT_ADD_WRAPV (n, *fmt - '0', &n); + } + if (overflow || min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n) + error ("Format width or precision too large"); + *value = n; + return fmt; +} + +/* Like doprnt, except FORMAT_END must be non-null. + Although this function is never exercised in current Emacs, + it is retained in case some future Emacs version + contains doprnt callers that need such formats. + Having a separate function helps GCC optimize doprnt better. */ +static ptrdiff_t +doprnt_non_null_end (char *buffer, ptrdiff_t bufsize, char const *format, + char const *format_end, va_list ap) +{ + USE_SAFE_ALLOCA; + ptrdiff_t fmtlen = format_end - format; + char *fmt = SAFE_ALLOCA (fmtlen + 1); + memcpy (fmt, format, fmtlen); + fmt[fmtlen] = 0; + ptrdiff_t nbytes = doprnt (buffer, bufsize, fmt, NULL, ap); + SAFE_FREE (); + return nbytes; +} + /* Generate output from a format-spec FORMAT, + terminated at either the first NUL or (if FORMAT_END is non-null + and there are no NUL bytes between FORMAT and FORMAT_END) terminated at position FORMAT_END. (*FORMAT_END is not part of the format, but must exist and be readable.) Output goes in BUFFER, which has room for BUFSIZE chars. @@ -131,12 +181,12 @@ ptrdiff_t doprnt (char *buffer, ptrdiff_t bufsize, const char *format, const char *format_end, va_list ap) { + if (format_end) + return doprnt_non_null_end (buffer, bufsize, format, format_end, ap); + const char *fmt = format; /* Pointer into format string. */ char *bufptr = buffer; /* Pointer into output buffer. */ - /* Enough to handle floating point formats with large numbers. */ - enum { SIZE_BOUND_EXTRA = DBL_MAX_10_EXP + 50 }; - /* Use this for sprintf unless we need something really big. */ char tembuf[SIZE_BOUND_EXTRA + 50]; @@ -150,103 +200,91 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, char *big_buffer = NULL; enum text_quoting_style quoting_style = text_quoting_style (); - ptrdiff_t tem = -1; - char *string; - char fixed_buffer[20]; /* Default buffer for small formatting. */ - char *fmtcpy; - int minlen; - char charbuf[MAX_MULTIBYTE_LENGTH + 1]; /* Used for %c. */ - USE_SAFE_ALLOCA; - - if (format_end == 0) - format_end = format + strlen (format); - - fmtcpy = (format_end - format < sizeof (fixed_buffer) - 1 - ? fixed_buffer - : SAFE_ALLOCA (format_end - format + 1)); bufsize--; /* Loop until end of format string or buffer full. */ - while (fmt < format_end && bufsize > 0) + while (*fmt && bufsize > 0) { char const *fmt0 = fmt; char fmtchar = *fmt++; if (fmtchar == '%') { - ptrdiff_t size_bound = 0; ptrdiff_t width; /* Columns occupied by STRING on display. */ enum { pDlen = sizeof pD - 1, pIlen = sizeof pI - 1, - pMlen = sizeof PRIdMAX - 2 + pMlen = sizeof PRIdMAX - 2, + maxmlen = max (max (1, pDlen), max (pIlen, pMlen)) }; enum { no_modifier, long_modifier, pD_modifier, pI_modifier, pM_modifier } length_modifier = no_modifier; static char const modifier_len[] = { 0, 1, pDlen, pIlen, pMlen }; - int maxmlen = max (max (1, pDlen), max (pIlen, pMlen)); int mlen; + char charbuf[MAX_MULTIBYTE_LENGTH + 1]; /* Used for %c. */ - /* Copy this one %-spec into fmtcpy. */ - string = fmtcpy; + /* Width and precision specified by this %-sequence. */ + int wid = 0, prec = -1; + + /* FMTSTAR will be a "%*.*X"-like version of this %-sequence. + Start by putting '%' into FMTSTAR. */ + char fmtstar[sizeof "%-+ 0*.*d" + maxmlen]; + char *string = fmtstar; *string++ = '%'; - while (fmt < format_end) + + /* Copy at most one instance of each flag into FMTSTAR. */ + bool minusflag = false, plusflag = false, zeroflag = false, + spaceflag = false; + for (;; fmt++) { - *string++ = *fmt; - if ('0' <= *fmt && *fmt <= '9') + *string = *fmt; + switch (*fmt) { - /* Get an idea of how much space we might need. - This might be a field width or a precision; e.g. - %1.1000f and %1000.1f both might need 1000+ bytes. - Parse the width or precision, checking for overflow. */ - int n = *fmt - '0'; - bool overflow = false; - while (fmt + 1 < format_end - && '0' <= fmt[1] && fmt[1] <= '9') - { - overflow |= INT_MULTIPLY_WRAPV (n, 10, &n); - overflow |= INT_ADD_WRAPV (n, fmt[1] - '0', &n); - *string++ = *++fmt; - } - - if (overflow - || min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n) - error ("Format width or precision too large"); - if (size_bound < n) - size_bound = n; + case '-': string += !minusflag; minusflag = true; continue; + case '+': string += !plusflag; plusflag = true; continue; + case ' ': string += !spaceflag; spaceflag = true; continue; + case '0': string += !zeroflag; zeroflag = true; continue; } - else if (! (*fmt == '-' || *fmt == ' ' || *fmt == '.' - || *fmt == '+')) - break; - fmt++; + break; } + /* Parse width and precision, putting "*.*" into FMTSTAR. */ + if ('1' <= *fmt && *fmt <= '9') + fmt = parse_format_integer (fmt, &wid); + if (*fmt == '.') + fmt = parse_format_integer (fmt + 1, &prec); + *string++ = '*'; + *string++ = '.'; + *string++ = '*'; + /* Check for the length modifiers in textual length order, so that longer modifiers override shorter ones. */ for (mlen = 1; mlen <= maxmlen; mlen++) { - if (format_end - fmt < mlen) - break; if (mlen == 1 && *fmt == 'l') length_modifier = long_modifier; - if (mlen == pDlen && memcmp (fmt, pD, pDlen) == 0) + if (mlen == pDlen && strncmp (fmt, pD, pDlen) == 0) length_modifier = pD_modifier; - if (mlen == pIlen && memcmp (fmt, pI, pIlen) == 0) + if (mlen == pIlen && strncmp (fmt, pI, pIlen) == 0) length_modifier = pI_modifier; - if (mlen == pMlen && memcmp (fmt, PRIdMAX, pMlen) == 0) + if (mlen == pMlen && strncmp (fmt, PRIdMAX, pMlen) == 0) length_modifier = pM_modifier; } + /* Copy optional length modifier and conversion specifier + character into FMTSTAR, and append a NUL. */ mlen = modifier_len[length_modifier]; - memcpy (string, fmt + 1, mlen); - string += mlen; + string = mempcpy (string, fmt, mlen + 1); fmt += mlen; *string = 0; - /* Make the size bound large enough to handle floating point formats + /* An idea of how much space we might need. + This might be a field width or a precision; e.g. + %1.1000f and %1000.1f both might need 1000+ bytes. + Make it large enough to handle floating point formats with large numbers. */ - size_bound += SIZE_BOUND_EXTRA; + ptrdiff_t size_bound = max (wid, prec) + SIZE_BOUND_EXTRA; /* Make sure we have that much. */ if (size_bound > size_allocated) @@ -257,48 +295,49 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, sprintf_buffer = big_buffer; size_allocated = size_bound; } - minlen = 0; + int minlen = 0; + ptrdiff_t tem; switch (*fmt++) { default: - error ("Invalid format operation %s", fmtcpy); + error ("Invalid format operation %s", fmt0); -/* case 'b': */ - case 'l': case 'd': switch (length_modifier) { case no_modifier: { int v = va_arg (ap, int); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case long_modifier: { long v = va_arg (ap, long); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pD_modifier: signed_pD_modifier: { ptrdiff_t v = va_arg (ap, ptrdiff_t); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pI_modifier: { EMACS_INT v = va_arg (ap, EMACS_INT); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pM_modifier: { intmax_t v = va_arg (ap, intmax_t); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; + default: + eassume (false); } /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; @@ -311,13 +350,13 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, case no_modifier: { unsigned v = va_arg (ap, unsigned); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case long_modifier: { unsigned long v = va_arg (ap, unsigned long); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pD_modifier: @@ -325,15 +364,17 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, case pI_modifier: { EMACS_UINT v = va_arg (ap, EMACS_UINT); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pM_modifier: { uintmax_t v = va_arg (ap, uintmax_t); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; + default: + eassume (false); } /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; @@ -344,18 +385,15 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, case 'g': { double d = va_arg (ap, double); - tem = sprintf (sprintf_buffer, fmtcpy, d); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, d); /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; goto doit; } case 'S': - string[-1] = 's'; - FALLTHROUGH; case 's': - if (fmtcpy[1] != 's') - minlen = atoi (&fmtcpy[1]); + minlen = minusflag ? -wid : wid; string = va_arg (ap, char *); tem = strnlen (string, STRING_BYTES_BOUND + 1); if (tem == STRING_BYTES_BOUND + 1) @@ -432,14 +470,12 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, string = charbuf; string[tem] = 0; width = strwidth (string, tem); - if (fmtcpy[1] != 'c') - minlen = atoi (&fmtcpy[1]); + minlen = minusflag ? -wid : wid; goto doit1; } case '%': /* Treat this '%' as normal. */ - fmt0 = fmt - 1; break; } } @@ -450,13 +486,13 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, src = uLSQM, srclen = sizeof uLSQM - 1; else if (quoting_style == CURVE_QUOTING_STYLE && fmtchar == '\'') src = uRSQM, srclen = sizeof uRSQM - 1; - else if (quoting_style == STRAIGHT_QUOTING_STYLE && fmtchar == '`') - src = "'", srclen = 1; else { - while (fmt < format_end && !CHAR_HEAD_P (*fmt)) - fmt++; - src = fmt0, srclen = fmt - fmt0; + if (quoting_style == STRAIGHT_QUOTING_STYLE && fmtchar == '`') + fmtchar = '\''; + eassert (ASCII_CHAR_P (fmtchar)); + *bufptr++ = fmtchar; + continue; } if (bufsize < srclen) @@ -479,8 +515,6 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, xfree (big_buffer); *bufptr = 0; /* Make sure our string ends with a '\0' */ - - SAFE_FREE (); return bufptr - buffer; } diff --git a/src/font.c b/src/font.c index fe257f47dc3..8dbf8cb8999 100644 --- a/src/font.c +++ b/src/font.c @@ -2645,6 +2645,11 @@ font_clear_cache (struct frame *f, Lisp_Object cache, if (! NILP (AREF (val, FONT_TYPE_INDEX))) { eassert (font && driver == font->driver); + /* We are going to close the font, so make + sure we don't have any lgstrings lying + around in lgstring cache that reference + the font. */ + composition_gstring_cache_clear_font (val); driver->close_font (font); } } @@ -4461,6 +4466,10 @@ GSTRING. */) signal_error ("Invalid glyph-string: ", gstring); if (! NILP (LGSTRING_ID (gstring))) return gstring; + Lisp_Object cached_gstring = + composition_gstring_lookup_cache (LGSTRING_HEADER (gstring)); + if (! NILP (cached_gstring)) + return cached_gstring; font_object = LGSTRING_FONT (gstring); CHECK_FONT_OBJECT (font_object); font = XFONT_OBJECT (font_object); diff --git a/src/frame.c b/src/frame.c index 0b707c2af87..7c377da4456 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2434,6 +2434,12 @@ passing the normal return value to that function as an argument, and returns whatever that function returns. */) (void) { + return mouse_position (true); +} + +Lisp_Object +mouse_position (bool call_mouse_position_function) +{ struct frame *f; Lisp_Object lispy_dummy; Lisp_Object x, y, retval; @@ -2462,7 +2468,7 @@ and returns whatever that function returns. */) } XSETFRAME (lispy_dummy, f); retval = Fcons (lispy_dummy, Fcons (x, y)); - if (!NILP (Vmouse_position_function)) + if (call_mouse_position_function && !NILP (Vmouse_position_function)) retval = call1 (Vmouse_position_function, retval); return retval; } @@ -6182,7 +6188,7 @@ window of that frame is the buffer whose text will be eventually shown in the minibuffer window. Any other non-nil value means to resize minibuffer-only frames by -calling `fit-frame-to-buffer'. */); +calling `fit-mini-frame-to-buffer'. */); resize_mini_frames = Qnil; DEFVAR_LISP ("focus-follows-mouse", focus_follows_mouse, diff --git a/src/frame.h b/src/frame.h index 476bac67faf..16ecfd311c3 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1361,6 +1361,7 @@ extern bool frame_inhibit_resize (struct frame *, bool, Lisp_Object); extern void adjust_frame_size (struct frame *, int, int, int, bool, Lisp_Object); extern void frame_size_history_add (struct frame *f, Lisp_Object fun_symbol, int width, int height, Lisp_Object rest); +extern Lisp_Object mouse_position (bool); extern Lisp_Object Vframe_list; diff --git a/src/image.c b/src/image.c index 5f6d9f4c443..61c5aa760c7 100644 --- a/src/image.c +++ b/src/image.c @@ -9543,10 +9543,16 @@ DEF_DLL_FN (gboolean, rsvg_handle_write, (RsvgHandle *, const guchar *, gsize, GError **)); DEF_DLL_FN (gboolean, rsvg_handle_close, (RsvgHandle *, GError **)); #endif + +#if LIBRSVG_CHECK_VERSION (2, 46, 0) +DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer, + (RsvgHandle *, const char *, const RsvgRectangle *, + RsvgRectangle *, RsvgRectangle *, GError **)); +#else DEF_DLL_FN (void, rsvg_handle_get_dimensions, (RsvgHandle *, RsvgDimensionData *)); +#endif DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *)); - DEF_DLL_FN (int, gdk_pixbuf_get_width, (const GdkPixbuf *)); DEF_DLL_FN (int, gdk_pixbuf_get_height, (const GdkPixbuf *)); DEF_DLL_FN (guchar *, gdk_pixbuf_get_pixels, (const GdkPixbuf *)); @@ -9592,7 +9598,11 @@ init_svg_functions (void) LOAD_DLL_FN (library, rsvg_handle_write); LOAD_DLL_FN (library, rsvg_handle_close); #endif +#if LIBRSVG_CHECK_VERSION (2, 46, 0) + LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer); +#else LOAD_DLL_FN (library, rsvg_handle_get_dimensions); +#endif LOAD_DLL_FN (library, rsvg_handle_get_pixbuf); LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width); @@ -9627,7 +9637,11 @@ init_svg_functions (void) # undef g_clear_error # undef g_object_unref # undef g_type_init -# undef rsvg_handle_get_dimensions +# if LIBRSVG_CHECK_VERSION (2, 46, 0) +# undef rsvg_handle_get_geometry_for_layer +# else +# undef rsvg_handle_get_dimensions +# endif # undef rsvg_handle_get_pixbuf # if LIBRSVG_CHECK_VERSION (2, 32, 0) # undef g_file_new_for_path @@ -9653,7 +9667,11 @@ init_svg_functions (void) # if ! GLIB_CHECK_VERSION (2, 36, 0) # define g_type_init fn_g_type_init # endif -# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions +# if LIBRSVG_CHECK_VERSION (2, 46, 0) +# define rsvg_handle_get_geometry_for_layer fn_rsvg_handle_get_geometry_for_layer +# else +# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions +# endif # define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf # if LIBRSVG_CHECK_VERSION (2, 32, 0) # define g_file_new_for_path fn_g_file_new_for_path diff --git a/src/nsxwidget.h b/src/nsxwidget.h index 3d91594c341..dcdb26cb34c 100644 --- a/src/nsxwidget.h +++ b/src/nsxwidget.h @@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */ +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef NSXWIDGET_H_INCLUDED #define NSXWIDGET_H_INCLUDED diff --git a/src/nsxwidget.m b/src/nsxwidget.m index 3c6402c03ff..dbd4cb29a62 100644 --- a/src/nsxwidget.m +++ b/src/nsxwidget.m @@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */ +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> diff --git a/src/term.c b/src/term.c index 53a1016183b..ff1aabfed23 100644 --- a/src/term.c +++ b/src/term.c @@ -2804,16 +2804,15 @@ tty_menu_calc_size (tty_menu *menu, int *width, int *height) static void mouse_get_xy (int *x, int *y) { - struct frame *sf = SELECTED_FRAME (); - Lisp_Object lmx = Qnil, lmy = Qnil, lisp_dummy; - enum scroll_bar_part part_dummy; - Time time_dummy; - - if (FRAME_TERMINAL (sf)->mouse_position_hook) - (*FRAME_TERMINAL (sf)->mouse_position_hook) (&sf, -1, - &lisp_dummy, &part_dummy, - &lmx, &lmy, - &time_dummy); + Lisp_Object lmx = Qnil, lmy = Qnil; + Lisp_Object mouse = mouse_position (tty_menu_calls_mouse_position_function); + + if (EQ (selected_frame, XCAR (mouse))) + { + lmx = XCAR (XCDR (mouse)); + lmy = XCDR (XCDR (mouse)); + } + if (!NILP (lmx)) { *x = XFIXNUM (lmx); @@ -4554,6 +4553,13 @@ What means \"very visible\" is up to your terminal. It may make the cursor bigger, or it may make it blink, or it may do nothing at all. */); visible_cursor = 1; + DEFVAR_BOOL ("tty-menu-calls-mouse-position-function", + tty_menu_calls_mouse_position_function, + doc: /* Non-nil means TTY menu code will call `mouse-position-function'. +This should be set if the function in `mouse-position-function' does not +trigger redisplay. */); + tty_menu_calls_mouse_position_function = 0; + defsubr (&Stty_display_color_p); defsubr (&Stty_display_color_cells); defsubr (&Stty_no_underline); diff --git a/src/w32heap.c b/src/w32heap.c index ba3550b6e9b..a72bed62caf 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -191,7 +191,7 @@ free_fn the_free_fn; /* It doesn't seem to be useful to allocate from a file mapping. It would be if the memory was shared. - http://stackoverflow.com/questions/307060/what-is-the-purpose-of-allocating-pages-in-the-pagefile-with-createfilemapping */ + https://stackoverflow.com/questions/307060/what-is-the-purpose-of-allocating-pages-in-the-pagefile-with-createfilemapping */ /* This is the function to commit memory when the heap allocator claims for new memory. Before dumping with unexec, we allocate @@ -246,7 +246,7 @@ init_heap (bool use_dynamic_heap) environment before starting GDB to get low fragmentation heap on XP and older systems, for the price of losing "certain heap debug options"; for the details see - http://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ + https://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ data_region_end = data_region_base; /* Create the private heap. */ diff --git a/src/xdisp.c b/src/xdisp.c index 5a62cd6eb52..cc499f33261 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -7555,7 +7555,7 @@ get_next_display_element (struct it *it) non-ASCII spaces and hyphens specially. */ if (! ASCII_CHAR_P (c) && ! NILP (Vnobreak_char_display)) { - if (c == NO_BREAK_SPACE) + if (blankp (c)) nonascii_space_p = true; else if (c == SOFT_HYPHEN || c == HYPHEN || c == NON_BREAKING_HYPHEN) @@ -18820,6 +18820,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Try to scroll by specified few lines. */ if ((0 < scroll_conservatively + || (scroll_minibuffer_conservatively && MINI_WINDOW_P (w)) || 0 < emacs_scroll_step || temp_scroll_step || NUMBERP (BVAR (current_buffer, scroll_up_aggressively)) @@ -18830,7 +18831,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* The function returns -1 if new fonts were loaded, 1 if successful, 0 if not successful. */ int ss = try_scrolling (window, just_this_one_p, - scroll_conservatively, + ((scroll_minibuffer_conservatively + && MINI_WINDOW_P (w)) + ? SCROLL_LIMIT + 1 + : scroll_conservatively), emacs_scroll_step, temp_scroll_step, last_line_misfit); switch (ss) @@ -22983,6 +22987,10 @@ maybe_produce_line_number (struct it *it) int lnum_face_id = merge_faces (it->w, Qline_number, 0, DEFAULT_FACE_ID); int current_lnum_face_id = merge_faces (it->w, Qline_number_current_line, 0, DEFAULT_FACE_ID); + /* From here onwards, we must prevent freeing realized faces, because + we are using the above 2 face IDs for the glyphs we produce. */ + bool save_free_realized_faces = inhibit_free_realized_faces; + inhibit_free_realized_faces = true; /* Compute point's line number if needed. */ if ((EQ (Vdisplay_line_numbers, Qrelative) || EQ (Vdisplay_line_numbers, Qvisual) @@ -23112,10 +23120,13 @@ maybe_produce_line_number (struct it *it) it->lnum_width = 0; it->lnum_pixel_width = 0; bidi_unshelve_cache (itdata, false); + inhibit_free_realized_faces = save_free_realized_faces; return; } } + inhibit_free_realized_faces = save_free_realized_faces; + /* Record the width in pixels we need for the line number display. */ it->lnum_pixel_width = tem_it.current_x; /* Copy the produced glyphs into IT's glyph_row. */ @@ -34531,7 +34542,14 @@ syms_of_xdisp (void) DEFSYM (Qredisplay_internal_xC_functionx, "redisplay_internal (C function)"); - DEFVAR_BOOL("inhibit-message", inhibit_message, + DEFVAR_BOOL ("scroll-minibuffer-conservatively", + scroll_minibuffer_conservatively, + doc: /* Non-nil means scroll conservatively in minibuffer windows. +When the value is nil, scrolling in minibuffer windows obeys the +settings of `scroll-conservatively'. */); + scroll_minibuffer_conservatively = true; /* bug#44070 */ + + DEFVAR_BOOL ("inhibit-message", inhibit_message, doc: /* Non-nil means calls to `message' are not displayed. They are still logged to the *Messages* buffer. @@ -34539,7 +34557,7 @@ Do NOT set this globally to a non-nil value, as doing that will disable messages everywhere, including in I-search and other places where they are necessary. This variable is intended to be let-bound around code that needs to disable messages temporarily. */); - inhibit_message = 0; + inhibit_message = false; message_dolog_marker1 = Fmake_marker (); staticpro (&message_dolog_marker1); @@ -34740,7 +34758,8 @@ If the value is t, Emacs highlights non-ASCII chars which have the same appearance as an ASCII space or hyphen, using the `nobreak-space' or `nobreak-hyphen' face respectively. -U+00A0 (no-break space), U+00AD (soft hyphen), U+2010 (hyphen), and +All of the non-ASCII characters in the Unicode horizontal whitespace +character class, as well as U+00AD (soft hyphen), U+2010 (hyphen), and U+2011 (non-breaking hyphen) are affected. Any other non-nil value means to display these characters as an escape @@ -35260,6 +35279,8 @@ It has no effect when set to 0, or when line numbers are not absolute. */); DEFVAR_BOOL ("display-fill-column-indicator", display_fill_column_indicator, doc: /* Non-nil means display the fill column indicator. +If you set this non-nil, make sure `display-fill-column-indicator-character' +is also non-nil. See Info node `Displaying Boundaries' for details. */); display_fill_column_indicator = false; DEFSYM (Qdisplay_fill_column_indicator, "display-fill-column-indicator"); @@ -35277,8 +35298,8 @@ See Info node `Displaying Boundaries' for details. */); DEFVAR_LISP ("display-fill-column-indicator-character", Vdisplay_fill_column_indicator_character, doc: /* Character to draw the indicator when `display-fill-column-indicator' is non-nil. -The default is U+2502 but a good alternative is (ascii 124) -if the font in fill-column-indicator face does not support Unicode characters. +A good candidate is U+2502, and an alternative is (ascii 124) if the +font of `fill-column-indicator' face does not support Unicode characters. See Info node `Displaying Boundaries' for details. */); Vdisplay_fill_column_indicator_character = Qnil; DEFSYM (Qdisplay_fill_column_indicator_character, "display-fill-column-indicator-character"); diff --git a/src/xwidget.c b/src/xwidget.c index e63191ebda9..031975fafb9 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -114,6 +114,13 @@ Returns the newly constructed xwidget, or nil if construction fails. */) if (EQ (xw->type, Qwebkit)) { block_input (); + WebKitWebContext *webkit_context = webkit_web_context_get_default (); + +# if WEBKIT_CHECK_VERSION (2, 26, 0) + if (!webkit_web_context_get_sandbox_enabled (webkit_context)) + webkit_web_context_set_sandbox_enabled (webkit_context, TRUE); +# endif + xw->widgetwindow_osr = gtk_offscreen_window_new (); gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, xw->height); @@ -152,7 +159,7 @@ Returns the newly constructed xwidget, or nil if construction fails. */) "load-changed", G_CALLBACK (webkit_view_load_changed_cb), xw); - g_signal_connect (G_OBJECT (webkit_web_context_get_default ()), + g_signal_connect (G_OBJECT (webkit_context), "download-started", G_CALLBACK (webkit_download_cb), xw); diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 1b26a3d2468..9ebf137f87c 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/lisp/calendar/solar-tests.el b/test/lisp/calendar/solar-tests.el new file mode 100644 index 00000000000..441beafe71c --- /dev/null +++ b/test/lisp/calendar/solar-tests.el @@ -0,0 +1,42 @@ +;;; solar-tests.el --- tests for solar.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 <https://www.gnu.org/licenses/>. + +(require 'ert) +(require 'solar) + +(ert-deftest solar-sunrise-sunset () + ;; Bug#44237: wrong sunrise time on Dec 30 and 31, 2020 for Jaipur. + (let ((calendar-latitude 26.9) + (calendar-longitude 75.8) + (calendar-time-zone +330) + (calendar-standard-time-zone-name "IST") + (calendar-daylight-time-zone-name "IST") + (epsilon (/ 60.0))) ; Minute accuracy is good enough. + (let* ((sunrise-sunset (solar-sunrise-sunset '(12 30 2020))) + (sunrise (car (nth 0 sunrise-sunset))) + (sunset (car (nth 1 sunrise-sunset)))) + (should (< (abs (- sunrise 7.27)) epsilon)) + (should (< (abs (- sunset 17.72)) epsilon))) + (let* ((sunrise-sunset (solar-sunrise-sunset '(12 31 2020))) + (sunrise (car (nth 0 sunrise-sunset))) + (sunset (car (nth 1 sunrise-sunset)))) + (should (< (abs (- sunrise 7.28)) epsilon)) + (should (< (abs (- sunset 17.72)) epsilon))))) + +(provide 'solar-tests) diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index 3f8954a8ff9..76a5641f34d 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -81,7 +81,14 @@ (ert-deftest test-format-seconds () (should (equal (format-seconds "%y %d %h %m %s %%" 0) "0 0 0 0 0 %")) (should (equal (format-seconds "%y %d %h %m %s %%" 9999999) "0 115 17 46 39 %")) - (should (equal (format-seconds "%y %d %h %m %z %s %%" 1) " 1 %"))) + (should (equal (format-seconds "%y %d %h %m %z %s %%" 1) " 1 %")) + (should (equal (format-seconds "%mm %ss" 66) "1m 6s")) + (should (equal (format-seconds "%mm %5ss" 66) "1m 6s")) + (should (equal (format-seconds "%mm %.5ss" 66.4) "1m 00006s")) + + (should (equal (format-seconds "%mm %,1ss" 66.4) "1m 6.4s")) + (should (equal (format-seconds "%mm %5,1ss" 66.4) "1m 6.4s")) + (should (equal (format-seconds "%mm %.5,1ss" 66.4) "1m 006.4s"))) (ert-deftest test-ordinal () (should (equal (date-ordinal-to-time 2008 271) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index ea5aacd7912..13cbedfe1f7 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -365,7 +365,12 @@ '(((a b)) a b (c) (d))) (mapcar (lambda (x) (cond ((memq '(a b) x) 1) ((equal x '(c)) 2))) - '(((a b)) a b (c) (d)))) + '(((a b)) a b (c) (d))) + + (assoc 'b '((a 1) (b 2) (c 3))) + (assoc "b" '(("a" 1) ("b" 2) ("c" 3))) + (let ((x '((a 1) (b 2) (c 3)))) (assoc 'c x)) + (assoc 'a '((a 1) (b 2) (c 3)) (lambda (u v) (not (equal u v))))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") diff --git a/test/lisp/emacs-lisp/copyright-tests.el b/test/lisp/emacs-lisp/copyright-tests.el new file mode 100644 index 00000000000..77b9e05da67 --- /dev/null +++ b/test/lisp/emacs-lisp/copyright-tests.el @@ -0,0 +1,50 @@ +;;; copyright-tests.el --- tests for copyright.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 <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'copyright) + +(defmacro with-copyright-test (orig result) + `(cl-letf (((symbol-function 'format-time-string) (lambda (&rest _) "2019"))) + (let ((copyright-query nil) + (copyright-current-year 2019)) + (with-temp-buffer + (insert ,orig) + (copyright-update) + (should (equal (buffer-string) ,result)))))) + +(defvar copyright-tests--data + '((";; Copyright (C) 2017 Free Software Foundation, Inc." + . ";; Copyright (C) 2017, 2019 Free Software Foundation, Inc.") + (";; Copyright (C) 2017-2018 Free Software Foundation, Inc." + . ";; Copyright (C) 2017-2019 Free Software Foundation, Inc.") + (";; Copyright (C) 2005-2006, 2015, 2017-2018 Free Software Foundation, Inc." + . ";; Copyright (C) 2005-2006, 2015, 2017-2019 Free Software Foundation, Inc.") + (";; copyright '18 FSF" + . ";; copyright '18, '19 FSF"))) + +(ert-deftest test-copyright-update () + (dolist (test copyright-tests--data) + (with-copyright-test (car test) (cdr test)))) + +(provide 'copyright-tests) +;;; copyright-tests.el ends here diff --git a/test/lisp/emacs-lisp/easy-mmode-tests.el b/test/lisp/emacs-lisp/easy-mmode-tests.el new file mode 100644 index 00000000000..4d7fe9444fb --- /dev/null +++ b/test/lisp/emacs-lisp/easy-mmode-tests.el @@ -0,0 +1,49 @@ +;;; easy-mmode-tests.el --- tests for easy-mmode.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 <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'easy-mmode) +(require 'message) + +(ert-deftest easy-mmode--globalized-predicate () + (with-temp-buffer + (emacs-lisp-mode) + (should (eq (easy-mmode--globalized-predicate-p nil) nil)) + (should (eq (easy-mmode--globalized-predicate-p t) t)) + (should (eq (easy-mmode--globalized-predicate-p '(not text-mode)) t)) + (should (eq (easy-mmode--globalized-predicate-p '(not text-mode)) t)) + (should (eq (easy-mmode--globalized-predicate-p '((not text-mode))) nil)) + (should (eq (easy-mmode--globalized-predicate-p '((not text-mode) t)) t)) + (should (eq (easy-mmode--globalized-predicate-p + '(c-mode emacs-lisp-mode)) + t)) + (mail-mode) + (should (eq (easy-mmode--globalized-predicate-p + '(c-mode (not message-mode mail-mode) text-mode)) + nil)) + (text-mode) + (should (eq (easy-mmode--globalized-predicate-p + '(c-mode (not message-mode mail-mode) text-mode)) + t)))) + +(provide 'easy-mmode-tests) + +;;; easy-mmode-tests.el ends here diff --git a/test/lisp/emacs-lisp/find-func-tests.el b/test/lisp/emacs-lisp/find-func-tests.el index f505e78566e..d77eb6757ff 100644 --- a/test/lisp/emacs-lisp/find-func-tests.el +++ b/test/lisp/emacs-lisp/find-func-tests.el @@ -5,18 +5,20 @@ ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see <https://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/lisp/emacs-lisp/text-property-search-tests.el b/test/lisp/emacs-lisp/text-property-search-tests.el index 83d4b95b76b..f643e49aa5e 100644 --- a/test/lisp/emacs-lisp/text-property-search-tests.el +++ b/test/lisp/emacs-lisp/text-property-search-tests.el @@ -153,6 +153,24 @@ 46 57 nil (point-max))) + +;;;; Position after search. + +(defun text-property-search--pos-test (fun pos &optional reverse) + (with-temp-buffer + (insert (concat "foo " + (propertize "bar" 'x t) + " baz")) + (goto-char (if reverse (point-max) (point-min))) + (funcall fun 'x t) + (should (= (point) pos)))) + +(ert-deftest text-property-search-forward-point-at-beginning () + (text-property-search--pos-test #'text-property-search-forward 5)) + +(ert-deftest text-property-search-backward-point-at-end () + (text-property-search--pos-test #'text-property-search-backward 8 t)) + (provide 'text-property-search-tests) ;;; text-property-search-tests.el ends here diff --git a/test/lisp/emacs-lisp/unsafep-tests.el b/test/lisp/emacs-lisp/unsafep-tests.el index 2b920a00ca4..06c40d28ca9 100644 --- a/test/lisp/emacs-lisp/unsafep-tests.el +++ b/test/lisp/emacs-lisp/unsafep-tests.el @@ -27,7 +27,7 @@ (defvar safe-functions) ;;; These forms are all considered safe -(defconst testcover-unsafep-safe +(defconst unsafep-tests--safe '(((lambda (x) (* x 2)) 14) (apply 'cdr (mapcar (lambda (x) (car x)) y)) (cond ((= x 4) 5) (t 27)) @@ -47,7 +47,7 @@ "List of forms that `unsafep' should decide are safe.") ;;; These forms are considered unsafe -(defconst testcover-unsafep-unsafe +(defconst unsafep-tests--unsafe '(( (add-to-list x y) . (unquoted x)) ( (add-to-list y x) @@ -105,26 +105,36 @@ . (variable (x))) ( (let (1) 2) . (variable 1)) + ( (error "asdf") + . #'error) + ( (signal 'error "asdf") + . #'signal) + ( (throw 'asdf) + . #'throw) + ( (catch 'asdf 17) + . #'catch) + ( (play-sound-file "asdf") + . #'play-sound-file) + ( (replace-regexp-in-string "a" "b") + . #'replace-regexp-in-string) ) - "A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.") + "A-list of (FORM . REASON)... that `unsafep' should decide are unsafe.") (ert-deftest test-unsafep/safe () - "Executes all unsafep tests and displays the coverage results." + "Check safe forms with safe-functions nil." (let (safe-functions) - (dolist (x testcover-unsafep-safe) + (dolist (x unsafep-tests--safe) (should-not (unsafep x))))) (ert-deftest test-unsafep/message () - ;; FIXME: This failed after converting these tests from testcover to - ;; ert. - :expected-result :failed - (should-not '(dolist (x y) (message "here: %s" x))) - (should-not '(dotimes (x 14 (* x 2)) (message "here: %d" x)))) + "Check that message is considered unsafe." + (should (unsafep '(dolist (x y) (message "here: %s" x)))) + (should (unsafep '(dotimes (x 14 (* x 2)) (message "here: %d" x))))) (ert-deftest test-unsafep/unsafe () - "Executes all unsafep tests and displays the coverage results." + "Check unsafe forms with safe-functions nil." (let (safe-functions) - (dolist (x testcover-unsafep-unsafe) + (dolist (x unsafep-tests--unsafe) (should (equal (unsafep (car x)) (cdr x)))))) (ert-deftest test-unsafep/safe-functions-t () diff --git a/test/data/epg/dummy-pinentry b/test/lisp/epg-resources/dummy-pinentry index 2228dfb0c6d..2228dfb0c6d 100755 --- a/test/data/epg/dummy-pinentry +++ b/test/lisp/epg-resources/dummy-pinentry diff --git a/test/data/epg/pubkey.asc b/test/lisp/epg-resources/pubkey.asc index c0bf28f6200..c0bf28f6200 100644 --- a/test/data/epg/pubkey.asc +++ b/test/lisp/epg-resources/pubkey.asc diff --git a/test/data/epg/seckey.asc b/test/lisp/epg-resources/seckey.asc index 4ac7ba4a502..4ac7ba4a502 100644 --- a/test/data/epg/seckey.asc +++ b/test/lisp/epg-resources/seckey.asc diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index 2a9c021c67b..c9c92f529be 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -22,14 +22,11 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'epg) (defvar epg-tests-context nil) -(defvar epg-tests-data-directory - (expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY")) - "Directory containing epg test data.") - (defconst epg-tests--config-program-alist ;; The default `epg-config--program-alist' requires gpg2 2.1 or ;; greater due to some practical problems with pinentry. But most @@ -85,8 +82,7 @@ '(with-temp-file (expand-file-name "gpg-agent.conf" epg-tests-home-directory) (insert "pinentry-program " - (expand-file-name "dummy-pinentry" - epg-tests-data-directory) + (ert-resource-file "dummy-pinentry") "\n") (epg-context-set-passphrase-callback context @@ -94,11 +90,11 @@ ,(if require-public-key '(epg-import-keys-from-file context - (expand-file-name "pubkey.asc" epg-tests-data-directory))) + (ert-resource-file "pubkey.asc"))) ,(if require-secret-key '(epg-import-keys-from-file context - (expand-file-name "seckey.asc" epg-tests-data-directory))) + (ert-resource-file "seckey.asc"))) (with-temp-buffer (make-local-variable 'epg-tests-context) (setq epg-tests-context context) diff --git a/test/data/themes/faces-test-dark-theme.el b/test/lisp/faces-resources/faces-test-dark-theme.el index a5e2ca43627..a5e2ca43627 100644 --- a/test/data/themes/faces-test-dark-theme.el +++ b/test/lisp/faces-resources/faces-test-dark-theme.el diff --git a/test/data/themes/faces-test-light-theme.el b/test/lisp/faces-resources/faces-test-light-theme.el index b2f7ec69742..b2f7ec69742 100644 --- a/test/data/themes/faces-test-light-theme.el +++ b/test/lisp/faces-resources/faces-test-light-theme.el diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el index 32dc1eea856..b19cef5decd 100644 --- a/test/lisp/faces-tests.el +++ b/test/lisp/faces-tests.el @@ -23,13 +23,9 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'faces) -(defvar faces--test-data-dir - (expand-file-name "../data/" - (file-name-directory (or load-file-name - buffer-file-name)))) - (defgroup faces--test nil "" :group 'faces--test) @@ -122,7 +118,7 @@ (should (equal (face-attribute 'spiff-changed-face :extend) t)) (should (equal (face-attribute 'spiff-added :extend) 'unspecified)) (should (equal (face-attribute 'spiff-file-header-face :extend) nil)) - (add-to-list 'custom-theme-load-path (concat faces--test-data-dir "themes")) + (add-to-list 'custom-theme-load-path (ert-resource-directory)) (load-theme 'faces-test-dark t t) (load-theme 'faces-test-light t t) (should (equal (face-attribute 'faces--test-inherit-extend :extend) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 47ed661ebf8..268c3185bc6 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el index 4869d162fb3..5a5e66594fa 100644 --- a/test/lisp/gnus/gnus-util-tests.el +++ b/test/lisp/gnus/gnus-util-tests.el @@ -16,7 +16,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/data/mml-sec/.gpg-v21-migrated b/test/lisp/gnus/mml-sec-resources/.gpg-v21-migrated index e69de29bb2d..e69de29bb2d 100644 --- a/test/data/mml-sec/.gpg-v21-migrated +++ b/test/lisp/gnus/mml-sec-resources/.gpg-v21-migrated diff --git a/test/data/mml-sec/gpg-agent.conf b/test/lisp/gnus/mml-sec-resources/gpg-agent.conf index 20192990caf..20192990caf 100644 --- a/test/data/mml-sec/gpg-agent.conf +++ b/test/lisp/gnus/mml-sec-resources/gpg-agent.conf diff --git a/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key Binary files differindex 58fd0b5edbc..58fd0b5edbc 100644 --- a/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key diff --git a/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key Binary files differindex 62f4ab25a69..62f4ab25a69 100644 --- a/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key diff --git a/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key Binary files differindex 2a8ce135fb2..2a8ce135fb2 100644 --- a/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key diff --git a/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key Binary files differindex 9f8de71c5e2..9f8de71c5e2 100644 --- a/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key diff --git a/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key Binary files differindex 6e4a4e548fd..6e4a4e548fd 100644 --- a/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key diff --git a/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key Binary files differindex cff58edaa89..cff58edaa89 100644 --- a/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key diff --git a/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key Binary files differindex 14af8662f79..14af8662f79 100644 --- a/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key diff --git a/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key Binary files differindex 207a7237d3a..207a7237d3a 100644 --- a/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key diff --git a/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key Binary files differindex 85ca78da04d..85ca78da04d 100644 --- a/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key diff --git a/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key Binary files differindex 79f3cd2b841..79f3cd2b841 100644 --- a/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key diff --git a/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key Binary files differindex 776ddf7e9e2..776ddf7e9e2 100644 --- a/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key diff --git a/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key Binary files differindex 2b464f0ccbe..2b464f0ccbe 100644 --- a/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key diff --git a/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key Binary files differindex 28a07668b21..28a07668b21 100644 --- a/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key diff --git a/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key Binary files differindex 137659693bd..137659693bd 100644 --- a/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key diff --git a/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key Binary files differindex c99824ccd43..c99824ccd43 100644 --- a/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key diff --git a/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key Binary files differindex 49c2dc58bd8..49c2dc58bd8 100644 --- a/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key diff --git a/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key Binary files differindex ca128408952..ca128408952 100644 --- a/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key diff --git a/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key Binary files differindex 3f14b40927a..3f14b40927a 100644 --- a/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key diff --git a/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key Binary files differindex 06adc06c427..06adc06c427 100644 --- a/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key diff --git a/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key Binary files differindex cf9a60d233b..cf9a60d233b 100644 --- a/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key diff --git a/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key Binary files differindex 0ed35172fe0..0ed35172fe0 100644 --- a/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key diff --git a/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key Binary files differindex 090059d9e81..090059d9e81 100644 --- a/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key diff --git a/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key Binary files differindex 9061f675121..9061f675121 100644 --- a/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key diff --git a/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key Binary files differindex 89f6013100d..89f6013100d 100644 --- a/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key diff --git a/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key Binary files differindex 41dac37574e..41dac37574e 100644 --- a/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key diff --git a/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key Binary files differindex 5df7b4a5953..5df7b4a5953 100644 --- a/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key diff --git a/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key Binary files differindex 03daf80975b..03daf80975b 100644 --- a/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key +++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key diff --git a/test/data/mml-sec/pubring.gpg b/test/lisp/gnus/mml-sec-resources/pubring.gpg Binary files differindex 6bd169963df..6bd169963df 100644 --- a/test/data/mml-sec/pubring.gpg +++ b/test/lisp/gnus/mml-sec-resources/pubring.gpg diff --git a/test/data/mml-sec/pubring.kbx b/test/lisp/gnus/mml-sec-resources/pubring.kbx Binary files differindex 399a0414fd2..399a0414fd2 100644 --- a/test/data/mml-sec/pubring.kbx +++ b/test/lisp/gnus/mml-sec-resources/pubring.kbx diff --git a/test/data/mml-sec/secring.gpg b/test/lisp/gnus/mml-sec-resources/secring.gpg Binary files differindex b323c072c04..b323c072c04 100644 --- a/test/data/mml-sec/secring.gpg +++ b/test/lisp/gnus/mml-sec-resources/secring.gpg diff --git a/test/data/mml-sec/trustdb.gpg b/test/lisp/gnus/mml-sec-resources/trustdb.gpg Binary files differindex 09ebd8db114..09ebd8db114 100644 --- a/test/data/mml-sec/trustdb.gpg +++ b/test/lisp/gnus/mml-sec-resources/trustdb.gpg diff --git a/test/data/mml-sec/trustlist.txt b/test/lisp/gnus/mml-sec-resources/trustlist.txt index f886572d283..f886572d283 100644 --- a/test/data/mml-sec/trustlist.txt +++ b/test/lisp/gnus/mml-sec-resources/trustlist.txt diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el index 427018520c8..a6002b4d51e 100644 --- a/test/lisp/gnus/mml-sec-tests.el +++ b/test/lisp/gnus/mml-sec-tests.el @@ -16,13 +16,14 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;;; Code: (require 'ert) +(require 'ert-x) (require 'message) (require 'epa) @@ -37,7 +38,10 @@ Mostly, the empty passphrase is used. However, the keys for as S/MIME).") (defun test-conf () - (ignore-errors (epg-find-configuration 'OpenPGP))) + ;; Emacs doesn't have support for finding the name of the PGP agent + ;; on MacOS, so disable the checks. + (and (not (eq system-type 'darwin)) + (ignore-errors (epg-find-configuration 'OpenPGP)))) (defun enc-standards () (if with-smime '(enc-pgp enc-pgp-mime enc-smime) @@ -65,8 +69,7 @@ instead of gpg-agent." (let ((agent-info (getenv "GPG_AGENT_INFO")) (gpghome (getenv "GNUPGHOME"))) (condition-case error - (let ((epg-gpg-home-directory - (expand-file-name "test/data/mml-sec" source-directory)) + (let ((epg-gpg-home-directory (ert-resource-directory)) (mml-smime-use 'epg) ;; Create debug output in empty epg-debug-buffer. (epg-debug t) @@ -880,8 +883,7 @@ So the second decryption fails." (equal (cdr (assq 'comm atts)) "gpg-agent") (string-match (concat "homedir.*" - (regexp-quote (expand-file-name "test/data/mml-sec" - source-directory))) + (regexp-quote (ert-resource-directory))) (cdr (assq 'args atts)))) (call-process "kill" nil nil nil (format "%d" pid)))))) diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el index 8267d8e4f6a..ddf22ecd404 100644 --- a/test/lisp/man-tests.el +++ b/test/lisp/man-tests.el @@ -44,7 +44,7 @@ sinl [sin] (3) - sine function" sin(3), sinf(3), sinl(3) - sine functions" . (#("sin(3)" 0 6 (help-echo "sine functions")) #("sinf(3)" 0 7 (help-echo "sine functions")) #("sinl(3)" 0 7 (help-echo "sine functions")))) ;; SunOS, Solaris - ;; http://docs.oracle.com/cd/E19455-01/805-6331/usradm-7/index.html + ;; https://docs.oracle.com/cd/E19455-01/805-6331/usradm-7/index.html ;; SunOS 4 ("\ tset, reset (1) - establish or restore terminal characteristics" @@ -61,7 +61,7 @@ cawf, nroff (1) - C version of the nroff-like, Amazingly Workable (text) Formatt whatis (5) - database of online manual pages" . (#("cawf(1)" 0 7 (help-echo "C version of the nroff-like, Amazingly Workable (text) Formatter")) #("nroff(1)" 0 8 (help-echo "C version of the nroff-like, Amazingly Workable (text) Formatter")) #("whatis(5)" 0 9 (help-echo "database of online manual pages")))) ;; HP-UX - ;; http://docstore.mik.ua/manuals/hp-ux/en/B2355-60130/man.1.html + ;; https://docstore.mik.ua/manuals/hp-ux/en/B2355-60130/man.1.html ;; Assuming that the line break in the zgrep description was ;; introduced by the man page formatting. ("\ diff --git a/test/data/minibuffer-test-cttq$tion b/test/lisp/minibuffer-resources/data/minibuffer-test-cttq$tion index e69de29bb2d..e69de29bb2d 100644 --- a/test/data/minibuffer-test-cttq$tion +++ b/test/lisp/minibuffer-resources/data/minibuffer-test-cttq$tion diff --git a/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest-c.test b/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest-c.test new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest-c.test diff --git a/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest.test b/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest.test new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/test/lisp/minibuffer-resources/lisp/cedet/semantic-utest.test diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 5da86f36148..32734794413 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -26,6 +26,9 @@ ;;; Code: +(require 'ert) +(require 'ert-x) + (eval-when-compile (require 'cl-lib)) (ert-deftest completion-test1 () @@ -85,7 +88,7 @@ (ert-deftest completion-table-test-quoting () (let ((process-environment `("CTTQ1=ed" "CTTQ2=et/" ,@process-environment)) - (default-directory (expand-file-name "test" source-directory))) + (default-directory (ert-resource-directory))) (pcase-dolist (`(,input ,output) '( ;; Test that $ in files is properly $$ quoted. diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 2186d454aee..3cfb4b7d9e7 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -125,7 +125,6 @@ (should-error (dbus-check-arguments :session dbus--test-service :object-path) :type 'wrong-type-argument) - ;; Raises an error on stderr. (should-error (dbus-check-arguments :session dbus--test-service :object-path "string") :type 'dbus-error) @@ -1889,6 +1888,112 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) +(ert-deftest dbus-test09-get-managed-objects () + "Check `dbus-get-all-managed-objects'." + :tags '(:expensive-test) + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + (dbus-register-service :session dbus--test-service) + + (unwind-protect + (let ((interfaces + `((,(concat dbus--test-interface ".I0") + ((,(concat dbus--test-path "/obj1") + (("I0Property1" . "Zero one one") + ("I0Property2" . "Zero one two") + ("I0Property3" . "Zero one three"))) + (,(concat dbus--test-path "/obj0/obj2") + (("I0Property1" . "Zero two one") + ("I0Property2" . "Zero two two") + ("I0Property3" . "Zero two three"))) + (,(concat dbus--test-path "/obj0/obj3") + (("I0Property1" . "Zero three one") + ("I0Property2" . "Zero three two") + ("I0Property3" . "Zero three three"))))) + (,(concat dbus--test-interface ".I1") + ((,(concat dbus--test-path "/obj0/obj2") + (("I1Property1" . "One one one") + ("I1Property2" . "One one two"))) + (,(concat dbus--test-path "/obj0/obj3") + (("I1Property1" . "One two one") + ("I1Property2" . "One two two")))))))) + + (should-not + (dbus-get-all-managed-objects + :session dbus--test-service dbus--test-path)) + + (dolist (interface interfaces) + (pcase-let ((`(,iname ,objs) interface)) + (dolist (obj objs) + (pcase-let ((`(,path ,props) obj)) + (dolist (prop props) + (should + (equal + (dbus-register-property + :session dbus--test-service path iname + (car prop) :readwrite (cdr prop)) + `((:property :session ,iname ,(car prop)) + (,dbus--test-service ,path))))))))) + + (let ((result (dbus-get-all-managed-objects + :session dbus--test-service dbus--test-path))) + (should + (= 3 (length result))) + + (dolist (interface interfaces) + (pcase-let ((`(,iname ,objs) interface)) + (dolist (obj objs) + (pcase-let ((`(,path ,props) obj)) + (let* ((object (cadr (assoc-string path result))) + (iface (cadr (assoc-string iname object)))) + (should object) + (should iface) + (dolist (prop props) + (should (equal (cdr (assoc-string (car prop) iface)) + (cdr prop)))))))))) + + (let ((result (dbus-get-all-managed-objects + :session dbus--test-service + (concat dbus--test-path "/obj0")))) + (should + (= 2 (length result))) + + (dolist (interface interfaces) + (pcase-let ((`(,iname ,objs) interface)) + (dolist (obj objs) + (pcase-let ((`(,path ,props) obj)) + (when (string-prefix-p (concat dbus--test-path "/obj0/") path) + (let* ((object (cadr (assoc-string path result))) + (iface (cadr (assoc-string iname object)))) + (should object) + (should iface) + (dolist (prop props) + (should (equal (cdr (assoc-string (car prop) iface)) + (cdr prop))))))))))) + + (let ((result (dbus-get-all-managed-objects + :session dbus--test-service + (concat dbus--test-path "/obj0/obj2")))) + (should + (= 1 (length result))) + + (dolist (interface interfaces) + (pcase-let ((`(,iname ,objs) interface)) + (dolist (obj objs) + (pcase-let ((`(,path ,props) obj)) + (when (string-prefix-p + (concat dbus--test-path "/obj0/obj2") path) + (let* ((object (cadr (assoc-string path result))) + (iface (cadr (assoc-string iname object)))) + (should object) + (should iface) + (dolist (prop props) + (should (equal (cdr (assoc-string (car prop) iface)) + (cdr prop)))))))))))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + (defun dbus-test-all (&optional interactive) "Run all tests for \\[dbus]." (interactive "p") diff --git a/test/lisp/net/netrc-resources/authinfo b/test/lisp/net/netrc-resources/authinfo new file mode 100644 index 00000000000..88aa1712e9d --- /dev/null +++ b/test/lisp/net/netrc-resources/authinfo @@ -0,0 +1,2 @@ +machine imap.example.org login jrh@example.org password "*foobar*" +machine ftp.example.org login jrh password "*baz*" diff --git a/test/lisp/net/netrc-resources/services b/test/lisp/net/netrc-resources/services new file mode 100644 index 00000000000..fd8a0348df2 --- /dev/null +++ b/test/lisp/net/netrc-resources/services @@ -0,0 +1,6 @@ +tcpmux 1/tcp # TCP port service multiplexer +smtp 25/tcp mail +http 80/tcp www # WorldWideWeb HTTP +kerberos 88/tcp kerberos5 krb5 kerberos-sec # Kerberos v5 +kerberos 88/udp kerberos5 krb5 kerberos-sec # Kerberos v5 +rtmp 1/ddp # Routing Table Maintenance Protocol diff --git a/test/lisp/net/netrc-tests.el b/test/lisp/net/netrc-tests.el new file mode 100644 index 00000000000..291943990ad --- /dev/null +++ b/test/lisp/net/netrc-tests.el @@ -0,0 +1,53 @@ +;;; netrc-tests.el --- Tests for netrc.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Stefan Kangas <stefankangas@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'netrc) + +(ert-deftest test-netrc-parse-services () + (let ((netrc-services-file (ert-resource-file "services"))) + (should (equal (netrc-parse-services) + '(("tcpmux" 1 tcp) + ("smtp" 25 tcp) + ("http" 80 tcp) + ("kerberos" 88 tcp) + ("kerberos" 88 udp) + ("rtmp" 1 ddp)))))) + +(ert-deftest test-netrc-find-service-name () + (let ((netrc-services-file (ert-resource-file "services"))) + (should (equal (netrc-find-service-name 25) "smtp")) + (should (equal (netrc-find-service-name 88 'udp) "kerberos")) + (should-not (netrc-find-service-name 12345)))) + +(ert-deftest test-netrc-credentials () + (let ((netrc-file (ert-resource-file "authinfo"))) + (should (equal (netrc-credentials "imap.example.org") + '("jrh@example.org" "*foobar*"))) + (should (equal (netrc-credentials "ftp.example.org") + '("jrh" "*baz*"))))) + +(provide 'netrc-tests) + +;;; netrc-tests.el ends here diff --git a/test/data/net/cert.pem b/test/lisp/net/network-stream-resources/cert.pem index 4df4e92e0bf..4df4e92e0bf 100644 --- a/test/data/net/cert.pem +++ b/test/lisp/net/network-stream-resources/cert.pem diff --git a/test/data/net/key.pem b/test/lisp/net/network-stream-resources/key.pem index 5db58f573ca..5db58f573ca 100644 --- a/test/data/net/key.pem +++ b/test/lisp/net/network-stream-resources/key.pem diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index cf416155e50..07eb2823282 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'ert) +(require 'ert-x) (require 'gnutls) (require 'network-stream) ;; The require above is needed for 'open-network-stream' to work, but @@ -239,16 +241,13 @@ (should (equal (buffer-string) "foo\n"))) (delete-process server))) -(defconst network-stream-tests--datadir - (expand-file-name "test/data/net" source-directory)) - (defun make-tls-server (port) (start-process "gnutls" (generate-new-buffer "*tls*") "gnutls-serv" "--http" "--x509keyfile" - (concat network-stream-tests--datadir "/key.pem") + (ert-resource-file "key.pem") "--x509certfile" - (concat network-stream-tests--datadir "/cert.pem") + (ert-resource-file "cert.pem") "--port" (format "%s" port))) (ert-deftest connect-to-tls-ipv4-wait () diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el new file mode 100644 index 00000000000..e515ebe2635 --- /dev/null +++ b/test/lisp/net/ntlm-tests.el @@ -0,0 +1,52 @@ +;;; ntlm-tests.el --- tests for ntlm.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 <https://www.gnu.org/licenses/>. + +(require 'ert) +(require 'ntlm) + +;; This is the Lisp bignum implementation of `ntlm--time-to-timestamp', +;; for reference. +(defun ntlm-tests--time-to-timestamp (time) + "Convert TIME to an NTLMv2 timestamp. +Return a unibyte string representing the number of tenths of a +microsecond since January 1, 1601 as a 64-bit little-endian +signed integer. TIME must be on the form (HIGH LOW USEC PSEC)." + (let* ((s (+ (ash (nth 0 time) 16) (nth 1 time))) + (us (nth 2 time)) + (ps (nth 3 time)) + (tenths-of-us-since-jan-1-1601 + (+ (* s 10000000) (* us 10) (/ ps 100000) + ;; tenths of microseconds between 1601-01-01 and 1970-01-01 + 116444736000000000))) + (apply #'unibyte-string + (mapcar (lambda (i) + (logand (ash tenths-of-us-since-jan-1-1601 (* i -8)) + #xff)) + (number-sequence 0 7))))) + +(ert-deftest ntlm-time-to-timestamp () + ;; Verify poor man's bignums in implementation that can run on Emacs < 27.1. + (let ((time '(24471 63910 412962 0))) + (should (equal (ntlm--time-to-timestamp time) + (ntlm-tests--time-to-timestamp time)))) + (let ((time '(397431 65535 999999 999999))) + (should (equal (ntlm--time-to-timestamp time) + (ntlm-tests--time-to-timestamp time))))) + +(provide 'ntlm-tests) diff --git a/test/lisp/net/rcirc-tests.el b/test/lisp/net/rcirc-tests.el index 8d14378b4ff..285926af9d2 100644 --- a/test/lisp/net/rcirc-tests.el +++ b/test/lisp/net/rcirc-tests.el @@ -2,18 +2,20 @@ ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: diff --git a/test/lisp/net/rfc2104-tests.el b/test/lisp/net/rfc2104-tests.el index 90535898382..e7d5a7f30e5 100644 --- a/test/lisp/net/rfc2104-tests.el +++ b/test/lisp/net/rfc2104-tests.el @@ -4,18 +4,20 @@ ;; Author: Lars Ingebrigtsen <larsi@gnus.org> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el index 6d420c4cb17..1e2cf3aef66 100644 --- a/test/lisp/net/secrets-tests.el +++ b/test/lisp/net/secrets-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: diff --git a/test/data/shr/div-div.html b/test/lisp/net/shr-resources/div-div.html index 1c191ae44d8..1c191ae44d8 100644 --- a/test/data/shr/div-div.html +++ b/test/lisp/net/shr-resources/div-div.html diff --git a/test/data/shr/div-div.txt b/test/lisp/net/shr-resources/div-div.txt index 62715e12513..62715e12513 100644 --- a/test/data/shr/div-div.txt +++ b/test/lisp/net/shr-resources/div-div.txt diff --git a/test/data/shr/div-p.html b/test/lisp/net/shr-resources/div-p.html index fcbdfc43293..fcbdfc43293 100644 --- a/test/data/shr/div-p.html +++ b/test/lisp/net/shr-resources/div-p.html diff --git a/test/data/shr/div-p.txt b/test/lisp/net/shr-resources/div-p.txt index 859d731da89..859d731da89 100644 --- a/test/data/shr/div-p.txt +++ b/test/lisp/net/shr-resources/div-p.txt diff --git a/test/data/shr/li-div.html b/test/lisp/net/shr-resources/li-div.html index eca3c511bd9..eca3c511bd9 100644 --- a/test/data/shr/li-div.html +++ b/test/lisp/net/shr-resources/li-div.html diff --git a/test/data/shr/li-div.txt b/test/lisp/net/shr-resources/li-div.txt index 9fc54f2bdc6..9fc54f2bdc6 100644 --- a/test/data/shr/li-div.txt +++ b/test/lisp/net/shr-resources/li-div.txt diff --git a/test/data/shr/li-empty.html b/test/lisp/net/shr-resources/li-empty.html index 05cfee7bdd4..05cfee7bdd4 100644 --- a/test/data/shr/li-empty.html +++ b/test/lisp/net/shr-resources/li-empty.html diff --git a/test/data/shr/li-empty.txt b/test/lisp/net/shr-resources/li-empty.txt index 906fd8df8b3..906fd8df8b3 100644 --- a/test/data/shr/li-empty.txt +++ b/test/lisp/net/shr-resources/li-empty.txt diff --git a/test/data/shr/nonbr.html b/test/lisp/net/shr-resources/nonbr.html index 56282cf4ca5..56282cf4ca5 100644 --- a/test/data/shr/nonbr.html +++ b/test/lisp/net/shr-resources/nonbr.html diff --git a/test/data/shr/nonbr.txt b/test/lisp/net/shr-resources/nonbr.txt index 0c3cffa93f9..0c3cffa93f9 100644 --- a/test/data/shr/nonbr.txt +++ b/test/lisp/net/shr-resources/nonbr.txt diff --git a/test/data/shr/ol.html b/test/lisp/net/shr-resources/ol.html index f9a15f26409..f9a15f26409 100644 --- a/test/data/shr/ol.html +++ b/test/lisp/net/shr-resources/ol.html diff --git a/test/data/shr/ol.txt b/test/lisp/net/shr-resources/ol.txt index 0d46e2a8ddb..0d46e2a8ddb 100644 --- a/test/data/shr/ol.txt +++ b/test/lisp/net/shr-resources/ol.txt diff --git a/test/data/shr/ul-empty.html b/test/lisp/net/shr-resources/ul-empty.html index e5a75ab9216..e5a75ab9216 100644 --- a/test/data/shr/ul-empty.html +++ b/test/lisp/net/shr-resources/ul-empty.html diff --git a/test/data/shr/ul-empty.txt b/test/lisp/net/shr-resources/ul-empty.txt index 8993555425b..8993555425b 100644 --- a/test/data/shr/ul-empty.txt +++ b/test/lisp/net/shr-resources/ul-empty.txt diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index 88a31bcf645..abc4f6a656b 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -23,14 +23,13 @@ ;;; Code: +(require 'ert) +(require 'ert-x) (require 'shr) -(defconst shr-tests--datadir - (expand-file-name "test/data/shr" source-directory)) - (defun shr-test (name) (with-temp-buffer - (insert-file-contents (format (concat shr-tests--datadir "/%s.html") name)) + (insert-file-contents (format (concat (ert-resource-directory) "/%s.html") name)) (let ((dom (libxml-parse-html-region (point-min) (point-max))) (shr-width 80) (shr-use-fonts nil)) @@ -39,7 +38,7 @@ (cons (buffer-substring-no-properties (point-min) (point-max)) (with-temp-buffer (insert-file-contents - (format (concat shr-tests--datadir "/%s.txt") name)) + (format (concat (ert-resource-directory) "/%s.txt") name)) (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) (replace-match (string (string-to-number (match-string 1) 16)) t t)) @@ -47,7 +46,7 @@ (ert-deftest rendering () (skip-unless (fboundp 'libxml-parse-html-region)) - (dolist (file (directory-files shr-tests--datadir nil "\\.html\\'")) + (dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'")) (let* ((name (replace-regexp-in-string "\\.html\\'" "" file)) (result (shr-test name))) (unless (equal (car result) (cdr result)) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 988288c045d..97c22fd2feb 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c894f7ddaaa..2c5b4bf18d8 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -4367,6 +4369,22 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-match "foo" (buffer-string)))) ;; Cleanup. + (ignore-errors (delete-process proc))) + + ;; PTY. + (unwind-protect + (with-temp-buffer + ;; It works only for tramp-sh.el, and not direct async processes. + (if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p)) + (should-error + (start-file-process "test4" (current-buffer) nil) + :type 'wrong-type-argument) + (setq proc (start-file-process "test4" (current-buffer) nil)) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (should (stringp (process-tty-name proc))))) + + ;; Cleanup. (ignore-errors (delete-process proc)))))) (defmacro tramp--test--deftest-direct-async-process diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index e67678cf6bb..9a7b5e4d6dd 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -108,8 +108,10 @@ This verifies that indenting a piece of code that ends in a paren without a statement terminator on the same line does not loop forever. The test starts an asynchronous Emacs batch process under timeout control." + :tags '(:expensive-test) (interactive) (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out + (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen (let* ((emacs (concat invocation-directory invocation-name)) (test-function 'cperl-mode-test--run-bug-10483) (test-function-name (symbol-name test-function)) @@ -118,7 +120,7 @@ under timeout control." (process-connection-type nil) runner) (with-temp-buffer - (with-timeout (1 + (with-timeout (2 (delete-process runner) (setq ran-out-of-time t)) (setq runner (start-process "speedy" @@ -218,4 +220,40 @@ point in the distant past, and is still broken in perl-mode. " (should (equal (nth 3 (syntax-ppss)) nil)) (should (equal (nth 4 (syntax-ppss)) t)))))) +(ert-deftest cperl-bug37127 () + "Verify that closing a paren in a regex goes without a message. +Also check that the message is issued if the regex terminator is +missing." + ;; Part one: Regex is ok, no messages + (ert-with-message-capture collected-messages + (with-temp-buffer + (insert "$_ =~ /(./;") + (funcall cperl-test-mode) + (goto-char (point-min)) + (search-forward ".") + (let ((last-command-event ?\)) + ;; Don't emit "Matches ..." even if not visible (e.g. in batch). + (blink-matching-paren 'jump-offscreen)) + (self-insert-command 1) + ;; `self-insert-command' doesn't call `blink-matching-open' in + ;; batch mode, so we need to call it explicitly. + (blink-matching-open)) + (syntax-propertize (point-max))) + (should (string-equal collected-messages ""))) + ;; part two: Regex terminator missing -> message + (when (eq cperl-test-mode #'cperl-mode) + ;; This test is only run in `cperl-mode' because only cperl-mode + ;; emits a message to warn about such unclosed REs. + (ert-with-message-capture collected-messages + (with-temp-buffer + (insert "$_ =~ /(..;") + (goto-char (point-min)) + (funcall cperl-test-mode) + (search-forward ".") + (let ((last-command-event ?\))) + (self-insert-command 1)) + (syntax-propertize (point-max))) + (should (string-match "^End of .* string/RE" + collected-messages))))) + ;;; cperl-mode-tests.el ends here diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index c62a2dbde13..df72b523a9d 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -23,10 +23,17 @@ ;;; Code: (require 'ert) -(require 'ert-x) (require 'flymake) (eval-when-compile (require 'subr-x)) ; string-trim +(defvar flymake-tests-data-directory + (expand-file-name "lisp/progmodes/flymake-resources" + (or (getenv "EMACS_TEST_DIRECTORY") + (expand-file-name "../../.." + (or load-file-name + buffer-file-name)))) + "Directory containing flymake test data.") + ;; ;; @@ -56,7 +63,7 @@ "Call FN after flymake setup in FILE, using `flymake-proc`. SEVERITY-PREDICATE is used to setup `flymake-proc-diagnostic-type-pred'" - (let* ((file (ert-resource-file file)) + (let* ((file (expand-file-name file flymake-tests-data-directory)) (visiting (find-buffer-visiting file)) (buffer (or visiting (find-file-noselect file))) (process-environment (cons "LC_ALL=C" process-environment)) diff --git a/test/lisp/progmodes/gdb-mi-tests.el b/test/lisp/progmodes/gdb-mi-tests.el new file mode 100644 index 00000000000..79493a571b6 --- /dev/null +++ b/test/lisp/progmodes/gdb-mi-tests.el @@ -0,0 +1,44 @@ +;;; gdb-mi-tests.el --- tests for gdb-mi.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 <https://www.gnu.org/licenses/>. + +(require 'ert) +(require 'gdb-mi) + +(ert-deftest gdb-mi-parse-value () + ;; Test the GDB/MI result/value parser. + (should (equal + (gdb-mi--from-string + "alpha=\"ab\\ncd\",beta=[\"x\",{gamma=\"y\",delta=[]}]") + '((alpha . "ab\ncd") + (beta . ("x" ((gamma . "y") (delta . ()))))))) + (should (equal + (gdb-mi--from-string + "alpha=\"ab\\ncd\",beta=[\"x\",{gamma=\"y\",delta=[]}]" + 'gamma) + '((alpha . "ab\ncd") + (beta . ("x" ("y" (delta . ()))))))) + + (should (equal (gdb-mi--from-string "alpha=\"a\\303\\245b\"") + `((alpha . ,(string-to-multibyte "a\303\245b"))))) + (let ((gdb-mi-decode-strings 'utf-8)) + (should (equal (gdb-mi--from-string "alpha=\"a\\303\\245b\"") + '((alpha . "aåb"))))) + ) + +(provide 'gdb-mi-tests) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index bc77443ff4f..64626333c44 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -204,7 +204,7 @@ aliqua." ;;; Indentation -;; See: http://www.python.org/dev/peps/pep-0008/#indentation +;; See: https://www.python.org/dev/peps/pep-0008/#indentation (ert-deftest python-indent-pep8-1 () "First pep8 case." diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb index 6b7d10dea38..95928030396 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb @@ -343,7 +343,7 @@ abc(foo tee .qux) -# http://stackoverflow.com/questions/17786563/emacs-ruby-mode-if-expressions-indentation +# https://stackoverflow.com/questions/17786563/emacs-ruby-mode-if-expressions-indentation tee = if foo bar else diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index 060c9cb5d1c..038f9d0e304 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -24,11 +24,13 @@ ;;; Code: (require 'ert) -(require 'ert-x) (require 'xref) (require 'cl-lib) -(defvar xref-tests-data-dir (ert-resource-directory)) +(defvar xref-tests-data-dir + (expand-file-name "xref-resources/" + (file-name-directory + (or load-file-name buffer-file-name)))) (ert-deftest xref-matches-in-directory-finds-none-for-some-regexp () (should (null (xref-matches-in-directory "zzz" "*" xref-tests-data-dir nil)))) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index f40f6a1cdb0..eed9cb534b1 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/lisp/textmodes/bibtex-tests.el b/test/lisp/textmodes/bibtex-tests.el index c12722fca13..56bd54efb74 100644 --- a/test/lisp/textmodes/bibtex-tests.el +++ b/test/lisp/textmodes/bibtex-tests.el @@ -17,7 +17,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/lisp/time-tests.el b/test/lisp/time-tests.el index 1a62450cb3a..2d327b959cc 100644 --- a/test/lisp/time-tests.el +++ b/test/lisp/time-tests.el @@ -49,6 +49,7 @@ (? digit) digit ":" digit digit (? (| "AM" "PM")) " " (+ (| digit ".")) + (? " Mail") string-end) display-time-string)))) diff --git a/test/data/vc/diff-mode/hello_emacs.c b/test/lisp/vc/diff-mode-resources/hello_emacs.c index c7ed7538c3a..c7ed7538c3a 100644 --- a/test/data/vc/diff-mode/hello_emacs.c +++ b/test/lisp/vc/diff-mode-resources/hello_emacs.c diff --git a/test/data/vc/diff-mode/hello_emacs_1.c b/test/lisp/vc/diff-mode-resources/hello_emacs_1.c index 62145a6b44a..62145a6b44a 100644 --- a/test/data/vc/diff-mode/hello_emacs_1.c +++ b/test/lisp/vc/diff-mode-resources/hello_emacs_1.c diff --git a/test/data/vc/diff-mode/hello_world.c b/test/lisp/vc/diff-mode-resources/hello_world.c index dcbe06c6012..dcbe06c6012 100644 --- a/test/data/vc/diff-mode/hello_world.c +++ b/test/lisp/vc/diff-mode-resources/hello_world.c diff --git a/test/data/vc/diff-mode/hello_world_1.c b/test/lisp/vc/diff-mode-resources/hello_world_1.c index 606afb371cb..606afb371cb 100644 --- a/test/data/vc/diff-mode/hello_world_1.c +++ b/test/lisp/vc/diff-mode-resources/hello_world_1.c diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index f17ec3648f1..b25836405cc 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -22,12 +22,11 @@ ;;; Code: +(require 'ert) +(require 'ert-x) (require 'diff-mode) (require 'diff) -(defconst diff-mode-tests--datadir - (expand-file-name "test/data/vc/diff-mode" source-directory)) - (ert-deftest diff-mode-test-ignore-trailing-dashes () "Check to make sure we successfully ignore trailing -- made by 'git format-patch'. This is bug #9597" @@ -209,11 +208,11 @@ youthfulness ;; See comments in diff-hunk-file-names about nonascii. ;; In such cases, the diff-font-lock-syntax portion of this fails. :expected-result (if (string-match-p "[[:nonascii:]]" - diff-mode-tests--datadir) + (ert-resource-directory)) :failed :passed) (skip-unless (executable-find shell-file-name)) (skip-unless (executable-find diff-command)) - (let ((default-directory diff-mode-tests--datadir) + (let ((default-directory (ert-resource-directory)) (old "hello_world.c") (new "hello_emacs.c") (diff-buffer (get-buffer-create "*Diff*")) @@ -274,11 +273,11 @@ youthfulness (ert-deftest diff-mode-test-font-lock-syntax-one-line () "Check diff syntax highlighting for one line with no newline at end." :expected-result (if (string-match-p "[[:nonascii:]]" - diff-mode-tests--datadir) + (ert-resource-directory)) :failed :passed) (skip-unless (executable-find shell-file-name)) (skip-unless (executable-find diff-command)) - (let ((default-directory diff-mode-tests--datadir) + (let ((default-directory (ert-resource-directory)) (old "hello_world_1.c") (new "hello_emacs_1.c") (diff-buffer (get-buffer-create "*Diff*")) diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el index a3a592bb623..15270d68cb5 100644 --- a/test/lisp/vc/ediff-ptch-tests.el +++ b/test/lisp/vc/ediff-ptch-tests.el @@ -4,18 +4,20 @@ ;; Author: Tino Calancha <tino.calancha@gmail.com> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el index d922e98348e..bd26f7979dc 100644 --- a/test/lisp/vc/vc-bzr-tests.el +++ b/test/lisp/vc/vc-bzr-tests.el @@ -37,7 +37,7 @@ ;; commands (eg `bzr status') want to access ~/.bazaar, and will ;; abort if they cannot. I could not figure out how to stop bzr ;; doing that, so just give it a temporary homedir for the duration. - ;; http://bugs.launchpad.net/bzr/+bug/137407 ? + ;; https://bugs.launchpad.net/bzr/+bug/137407 ? ;; ;; Note that with bzr 2.x, this works: ;; mkdir /tmp/bzr diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el index 01d196565dd..7b88b8d531a 100644 --- a/test/lisp/vc/vc-tests.el +++ b/test/lisp/vc/vc-tests.el @@ -4,18 +4,20 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/data/xdg/l10n.desktop b/test/lisp/xdg-resources/l10n.desktop index 42da83910da..42da83910da 100644 --- a/test/data/xdg/l10n.desktop +++ b/test/lisp/xdg-resources/l10n.desktop diff --git a/test/data/xdg/malformed.desktop b/test/lisp/xdg-resources/malformed.desktop index 144a3f719d5..144a3f719d5 100644 --- a/test/data/xdg/malformed.desktop +++ b/test/lisp/xdg-resources/malformed.desktop diff --git a/test/data/xdg/mimeapps.list b/test/lisp/xdg-resources/mimeapps.list index 27fbd94b16b..27fbd94b16b 100644 --- a/test/data/xdg/mimeapps.list +++ b/test/lisp/xdg-resources/mimeapps.list diff --git a/test/data/xdg/mimeinfo.cache b/test/lisp/xdg-resources/mimeinfo.cache index 6e54f604fa0..6e54f604fa0 100644 --- a/test/data/xdg/mimeinfo.cache +++ b/test/lisp/xdg-resources/mimeinfo.cache diff --git a/test/data/xdg/test.desktop b/test/lisp/xdg-resources/test.desktop index b848cef5b0f..b848cef5b0f 100644 --- a/test/data/xdg/test.desktop +++ b/test/lisp/xdg-resources/test.desktop diff --git a/test/data/xdg/wrong.desktop b/test/lisp/xdg-resources/wrong.desktop index e0b4c221cf9..e0b4c221cf9 100644 --- a/test/data/xdg/wrong.desktop +++ b/test/lisp/xdg-resources/wrong.desktop diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el index 294996af5f8..c2a16006c35 100644 --- a/test/lisp/xdg-tests.el +++ b/test/lisp/xdg-tests.el @@ -25,26 +25,20 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'xdg) -(defconst xdg-tests-data-dir - (expand-file-name "test/data/xdg" source-directory)) - (ert-deftest xdg-desktop-parsing () "Test `xdg-desktop-read-file' parsing of .desktop files." - (let ((tab1 (xdg-desktop-read-file - (expand-file-name "test.desktop" xdg-tests-data-dir))) - (tab2 (xdg-desktop-read-file - (expand-file-name "test.desktop" xdg-tests-data-dir) + (let ((tab1 (xdg-desktop-read-file (ert-resource-file "test.desktop"))) + (tab2 (xdg-desktop-read-file (ert-resource-file "test.desktop") "Another Section"))) (should (equal (gethash "Name" tab1) "Test")) (should (eq 'default (gethash "Exec" tab1 'default))) (should (equal "frobnicate" (gethash "Exec" tab2)))) (should-error - (xdg-desktop-read-file - (expand-file-name "malformed.desktop" xdg-tests-data-dir))) - (let ((tab (xdg-desktop-read-file - (expand-file-name "l10n.desktop" xdg-tests-data-dir))) + (xdg-desktop-read-file (ert-resource-file "malformed.desktop"))) + (let ((tab (xdg-desktop-read-file (ert-resource-file "l10n.desktop"))) (env (getenv "LC_MESSAGES"))) (unwind-protect (progn @@ -67,8 +61,8 @@ (ert-deftest xdg-mime-associations () "Test reading MIME associations from files." - (let* ((apps (expand-file-name "mimeapps.list" xdg-tests-data-dir)) - (cache (expand-file-name "mimeinfo.cache" xdg-tests-data-dir)) + (let* ((apps (ert-resource-file "mimeapps.list")) + (cache (ert-resource-file "mimeinfo.cache")) (fs (list apps cache))) (should (equal (xdg-mime-collect-associations "x-test/foo" fs) '("a.desktop" "b.desktop"))) diff --git a/test/lisp/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el index 61bd7590183..12840df13fe 100644 --- a/test/lisp/xt-mouse-tests.el +++ b/test/lisp/xt-mouse-tests.el @@ -53,9 +53,9 @@ (ert-deftest xt-mouse-tracking-basic () (should (equal (xterm-mouse-tracking-enable-sequence) - "\e[?1000h\e[?1002h\e[?1006h")) + "\e[?1000h\e[?1003h\e[?1006h")) (should (equal (xterm-mouse-tracking-disable-sequence) - "\e[?1006l\e[?1002l\e[?1000l")) + "\e[?1006l\e[?1003l\e[?1000l")) (with-xterm-mouse-mode (should xterm-mouse-mode) (should (terminal-parameter nil 'xterm-mouse-mode)) @@ -73,9 +73,9 @@ (ert-deftest xt-mouse-tracking-utf-8 () (let ((xterm-mouse-utf-8 t)) (should (equal (xterm-mouse-tracking-enable-sequence) - "\e[?1000h\e[?1002h\e[?1005h\e[?1006h")) + "\e[?1000h\e[?1003h\e[?1005h\e[?1006h")) (should (equal (xterm-mouse-tracking-disable-sequence) - "\e[?1006l\e[?1005l\e[?1002l\e[?1000l")) + "\e[?1006l\e[?1005l\e[?1003l\e[?1000l")) (with-xterm-mouse-mode (should xterm-mouse-mode) (should (terminal-parameter nil 'xterm-mouse-mode)) diff --git a/test/manual/biditest.el b/test/manual/biditest.el index 71a44ae429a..c4ee96a79c6 100644 --- a/test/manual/biditest.el +++ b/test/manual/biditest.el @@ -6,12 +6,14 @@ ;; Maintainer: emacs-devel@gnu.org ;; Package: emacs -;; This program is free software: you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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. diff --git a/test/manual/image-transforms-tests.el b/test/manual/image-transforms-tests.el index 02607e63676..13d74a7c4b5 100644 --- a/test/manual/image-transforms-tests.el +++ b/test/manual/image-transforms-tests.el @@ -1,4 +1,4 @@ -;;; image-transform-tests.el --- Test suite for image transforms. +;;; image-transform-tests.el --- Test suite for image transforms. -*- lexical-binding: t -*- ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. diff --git a/test/manual/indent/tcl.tcl b/test/manual/indent/tcl.tcl new file mode 100644 index 00000000000..c3781533ca4 --- /dev/null +++ b/test/manual/indent/tcl.tcl @@ -0,0 +1,22 @@ +# Some sample code that tries to exercise the font-lock +# of various forms of writing strings. + +puts "hello}"; # Top-level strings can contain unescaped closing braces! + +puts a"b; # Non-delimited strings can contain quotes! +puts a""b; # Even several of them! + +proc foo1 {} { + puts "hello"; # Normal case! + puts "hello\}; # This will signal an error when `foo1` is called! +} + +proc foo2 {} { + puts "hello; # This will also signal an error when `foo2` is called! +} + +proc foo3 {} { + puts a"b; # This will not signal an error! + puts a""b"; # And that won't either! + puts "a""b"; # But this will! +} diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el index b26a276c61b..182e2df93bc 100644 --- a/test/src/undo-tests.el +++ b/test/src/undo-tests.el @@ -4,18 +4,20 @@ ;; Author: Aaron S. Hawley <aaron.s.hawley@gmail.com> -;; This program is free software: you can redistribute it and/or +;; 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. ;; -;; This program is distributed in the hope that it will be useful, but +;; 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 this program. If not, see `https://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el index 95c39dacc3e..fad90fad531 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -21,34 +21,55 @@ (require 'ert) +(defmacro xdisp-tests--in-minibuffer (&rest body) + (declare (debug t) (indent 0)) + `(catch 'result + (minibuffer-with-setup-hook + (lambda () + (let ((redisplay-skip-initial-frame nil) + (executing-kbd-macro nil)) ;Don't skip redisplay + (throw 'result (progn . ,body)))) + (let ((executing-kbd-macro t)) ;Force real minibuffer in `read-string'. + (read-string "toto: "))))) + (ert-deftest xdisp-tests--minibuffer-resizing () ;; bug#43519 - ;; FIXME: This test returns success when run in batch but - ;; it's only a lucky accident: it also returned success - ;; when bug#43519 was not fixed. (should (equal t - (catch 'result - (minibuffer-with-setup-hook - (lambda () - (insert "hello") - (let ((ol (make-overlay (point) (point))) - (redisplay-skip-initial-frame nil) - (max-mini-window-height 1) - (text "askdjfhaklsjdfhlkasjdfhklasdhflkasdhflkajsdhflkashdfkljahsdlfkjahsdlfkjhasldkfhalskdjfhalskdfhlaksdhfklasdhflkasdhflkasdhflkajsdhklajsdgh")) - ;; (save-excursion (insert text)) - ;; (sit-for 2) - ;; (delete-region (point) (point-max)) - (put-text-property 0 1 'cursor t text) - (overlay-put ol 'after-string text) - (let ((executing-kbd-macro nil)) ;Don't skip redisplay - (redisplay 'force)) - (throw 'result - ;; Make sure we do the see "hello" text. - (prog1 (equal (window-start) (point-min)) - ;; (list (window-start) (window-end) (window-width)) - (delete-overlay ol))))) - (let ((executing-kbd-macro t)) ;Force real minibuffer in `read-string'. - (read-string "toto: "))))))) + (xdisp-tests--in-minibuffer + (insert "hello") + (let ((ol (make-overlay (point) (point))) + (max-mini-window-height 1) + (text "askdjfhaklsjdfhlkasjdfhklasdhflkasdhflkajsdhflkashdfkljahsdlfkjahsdlfkjhasldkfhalskdjfhalskdfhlaksdhfklasdhflkasdhflkasdhflkajsdhklajsdgh")) + ;; (save-excursion (insert text)) + ;; (sit-for 2) + ;; (delete-region (point) (point-max)) + (put-text-property 0 1 'cursor t text) + (overlay-put ol 'after-string text) + (redisplay 'force) + ;; Make sure we do the see "hello" text. + (prog1 (equal (window-start) (point-min)) + ;; (list (window-start) (window-end) (window-width)) + (delete-overlay ol))))))) + +(ert-deftest xdisp-tests--minibuffer-scroll () ;; bug#44070 + (let ((posns + (xdisp-tests--in-minibuffer + (let ((max-mini-window-height 4)) + (dotimes (_ 80) (insert "\nhello")) + (beginning-of-buffer) + (redisplay 'force) + (end-of-buffer) + ;; A simple edit like removing the last `o' shouldn't cause + ;; the rest of the minibuffer's text to move. + (list + (progn (redisplay 'force) (window-start)) + (progn (delete-char -1) + (redisplay 'force) (window-start)) + (progn (goto-char (point-min)) (redisplay 'force) + (goto-char (point-max)) (redisplay 'force) + (window-start))))))) + (should (equal (nth 0 posns) (nth 1 posns))) + (should (equal (nth 1 posns) (nth 2 posns))))) ;;; xdisp-tests.el ends here |