diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2020-07-22 17:34:42 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2020-07-22 17:34:42 -0700 |
| commit | 60fb4071f2b63eeae2275e9324af4d024cdb820d (patch) | |
| tree | 1057502622c40744b2833cb926df116f0d97910b | |
| parent | d5ca54cce270ba14fe1f966be96e40f3f9b0d507 (diff) | |
| parent | 1bae7ba53b8239201853ce755e9e21a96ad279c0 (diff) | |
| download | emacs-60fb4071f2b63eeae2275e9324af4d024cdb820d.tar.gz | |
Merge remote-tracking branch 'origin/master' into athena/unstable
131 files changed, 2702 insertions, 1704 deletions
diff --git a/.gitignore b/.gitignore index d4be6bb23eb..890e63a4318 100644 --- a/.gitignore +++ b/.gitignore @@ -60,6 +60,7 @@ lib/execinfo.h lib/fcntl.h lib/getopt.h lib/getopt-cdefs.h +lib/gmp.h lib/ieee754.h lib/inttypes.h lib/libgnu.a diff --git a/CONTRIBUTE b/CONTRIBUTE index 26efbd7e5aa..4e42c7aafcc 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -63,7 +63,7 @@ also possible to use a command like However, we prefer the 'git format-patch' method with attachment, as doing so delivers patches in the correct and easily-recognizable format more reliably, and makes the job of applying the patches easier and less -error-prone. It also allows to send patches whose author is someone +error-prone. It also allows sending patches whose author is someone other than the email sender. Once the cumulative amount of your submissions exceeds about 15 lines diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 5a78b052b24..3f32536a629 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -36,7 +36,7 @@ GNULIB_MODULES=' fchmodat fcntl fcntl-h fdopendir filemode filename filevercmp flexmember fpieee fstatat fsusage fsync futimens getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog - ieee754-h ignore-value intprops largefile lstat + ieee754-h ignore-value intprops largefile libgmp lstat manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime pathmax pipe2 pselect pthread_sigmask qcopy-acl readlink readlinkat regex diff --git a/configure.ac b/configure.ac index 6ede6104d39..148c50e0b39 100644 --- a/configure.ac +++ b/configure.ac @@ -1030,14 +1030,17 @@ AS_IF([test $gl_gcc_warnings = no], ;; esac AS_IF([test $gl_gcc_warnings = yes], - [WERROR_CFLAGS=-Werror]) + [WERROR_CFLAGS=-Werror], + [# Use -fanalyzer and related options only if --enable-gcc-warnings, + # as they slow GCC considerably. + nw="$nw -fanalyzer -Wno-analyzer-double-free -Wno-analyzer-malloc-leak" + nw="$nw -Wno-analyzer-null-dereference -Wno-analyzer-use-after-free"]) - nw="$nw -Wcast-align -Wcast-align=strict" # Emacs is tricky with pointers. + nw="$nw -Wcast-align=strict" # Emacs is tricky with pointers. nw="$nw -Wduplicated-branches" # Too many false alarms nw="$nw -Wformat-overflow=2" # False alarms due to GCC bug 80776 nw="$nw -Wsystem-headers" # Don't let system headers trigger warnings nw="$nw -Woverlength-strings" # Not a problem these days - nw="$nw -Wformat-nonliteral" # we do this a lot nw="$nw -Wvla" # Emacs uses <vla.h>. nw="$nw -Wunused-const-variable=2" # lisp.h declares const objects. nw="$nw -Winline" # OK to ignore 'inline' @@ -1046,7 +1049,6 @@ AS_IF([test $gl_gcc_warnings = no], nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations nw="$nw -Wbad-function-cast" # These casts are no worse than others. - nw="$nw -Wabi" # Not useful, perceived as noise # Emacs doesn't care about shadowing; see # <https://lists.gnu.org/r/emacs-diffs/2011-11/msg00265.html>. @@ -1066,26 +1068,12 @@ AS_IF([test $gl_gcc_warnings = no], # option problematic. nw="$nw -Wsuggest-attribute=pure" - # This part is merely for shortening the command line, - # since -Wall implies -Wswitch. - nw="$nw -Wswitch" - - # This part is merely for shortening the command line, - # since -Wno-FOO needs to be added below regardless. - nw="$nw -Wmissing-field-initializers" - nw="$nw -Woverride-init" - nw="$nw -Wtype-limits" - nw="$nw -Wunused-parameter" - if test "$emacs_cv_clang" = yes; then - nw="$nw -Wcast-align" nw="$nw -Wdouble-promotion" - nw="$nw -Wmissing-braces" fi - # These cause too much noise in the MinGW build + # This causes too much noise in the MinGW build. if test $opsys = mingw32; then - nw="$nw -Wpointer-sign" nw="$nw -Wsuggest-attribute=format" fi @@ -4519,32 +4507,6 @@ AC_SUBST(KRB5LIB) AC_SUBST(DESLIB) AC_SUBST(KRB4LIB) -AC_ARG_WITH([libgmp], - [AS_HELP_STRING([--without-libgmp], - [don't use the GNU Multiple Precision (GMP) library; - this is the default on systems lacking libgmp.])]) -GMP_LIB= -GMP_OBJ=mini-gmp-emacs.o -HAVE_GMP=no -case $with_libgmp in - no) ;; - yes) HAVE_GMP=yes GMP_LIB=-lgmp;; - *) AC_CHECK_HEADERS([gmp.h], - [OLIBS=$LIBS - AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) - LIBS=$OLIBS - case $ac_cv_search___gmpz_roinit_n in - 'none needed') HAVE_GMP=yes;; - -*) HAVE_GMP=yes GMP_LIB=$ac_cv_search___gmpz_roinit_n;; - esac]);; -esac -if test "$HAVE_GMP" = yes; then - GMP_OBJ= - AC_DEFINE([HAVE_GMP], 1, [Define to 1 if you have recent-enough GMP.]) -fi -AC_SUBST([GMP_LIB]) -AC_SUBST([GMP_OBJ]) - AC_CHECK_HEADERS(valgrind/valgrind.h) AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]]) @@ -5712,6 +5674,11 @@ done AC_DEFINE_UNQUOTED(EMACS_CONFIG_FEATURES, "${emacs_config_features}", [Summary of some of the main features enabled by configure.]) +if test -z "$GMP_H"; then + HAVE_GMP=yes +else + HAVE_GMP=no +fi AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D} Does Emacs use -lXpm? ${HAVE_XPM} Does Emacs use -ljpeg? ${HAVE_JPEG} @@ -5740,7 +5707,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use -lxft? ${HAVE_XFT} Does Emacs use -lsystemd? ${HAVE_LIBSYSTEMD} Does Emacs use -ljansson? ${HAVE_JSON} - Does Emacs use -lgmp? ${HAVE_GMP} + Does Emacs use the GMP library? ${HAVE_GMP} Does Emacs directly use zlib? ${HAVE_ZLIB} Does Emacs have dynamic modules support? ${HAVE_MODULES} Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS} diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index d034a78501b..00c8ee4f98b 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1223,7 +1223,7 @@ other context has no special meaning. disable a minor mode in a local variables list, use the @code{eval} keyword with a Lisp expression that runs the mode command (@pxref{Minor Modes}). For example, the following local variables -list enables Eldoc mode (@pxref{Lisp Doc}) by calling +list enables ElDoc mode (@pxref{Lisp Doc}) by calling @code{eldoc-mode} with no argument (calling it with an argument of 1 would do the same), and disables Font Lock mode (@pxref{Font Lock}) by calling @code{font-lock-mode} with an argument of @minus{}1. @@ -2252,10 +2252,13 @@ as a function from Lisp programs. When Emacs is started, it normally tries to load a Lisp program from an @dfn{initialization file}, or @dfn{init file} for short. This file, if it exists, specifies how to initialize Emacs for you. -If the file @file{~/.config/emacs/init.el} exists, it is used as the -init file; otherwise Emacs may look at @file{~/.emacs.el}, -@file{~/.emacs}, @file{~/.emacs.d/init.el}, or other locations. -@xref{Find Init}. +Traditionally, file @file{~/.emacs} is used as the init file, although +Emacs also looks at @file{~/.emacs.el}, @file{~/.emacs.d/init.el}, +@file{~/.config/emacs/init.el}, or other locations. @xref{Find Init}. + +You may find it convenient to have all your Emacs configuration in one +directory, in which case you should use @file{~/.emacs.d/init.el} or +the XDG-compatible @file{~/.config/emacs/init.el}. You can use the command line switch @samp{-q} to prevent loading your init file, and @samp{-u} (or @samp{--user}) to specify a @@ -2661,23 +2664,21 @@ library. @xref{Hooks}. @subsection How Emacs Finds Your Init File Emacs normally finds your init file in a location under your home -directory. @xref{Init File}. By default this location is -@file{~/.emacs.d/init.el} where @file{~/} stands for your home directory. -This default can be overridden as described below. +directory. @xref{Init File}. -Emacs looks for your init file -using the filenames @file{~/.emacs.el}, @file{~/.emacs}, or -@file{~/.emacs.d/init.el}; you can choose to use any one of these -names. (Note that only the locations directly in your home directory -have a leading dot in the location's basename.) + Emacs looks for your init file using the filenames @file{~/.emacs.el}, +@file{~/.emacs}, or @file{~/.emacs.d/init.el} in that order; you can +choose to use any one of these names. (Note that only the locations +directly in your home directory have a leading dot in the location's +basename.) Emacs can also look in an XDG-compatible location for @file{init.el}, the default is the directory @file{~/.config/emacs}. This can be overriden by setting @env{XDG_CONFIG_HOME} in your environment, its value replaces @file{~/.config} in the name of the default XDG init -file. However @file{~/.emacs.d} and @file{~/.emacs} are always -preferred if they exist, which means that you must delete or rename -them in order to use the XDG location. +file. However @file{~/.emacs.d}, @file{~/.emacs}, and +@file{~/.emacs.el} are always preferred if they exist, which means +that you must delete or rename them in order to use the XDG location. Note also that if neither the XDG location nor @file{~/.emacs.d} exist, then Emacs will create @file{~/.emacs.d} (and therefore use it diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index a2ace00cbbc..e96e43b377d 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1584,7 +1584,9 @@ sequences}, with the @code{escape-glyph} face. For instance, character code @code{U+0098} (octal 230) is displayed as @samp{\230}. If you change the buffer-local variable @code{ctl-arrow} to @code{nil}, the @acronym{ASCII} control characters are also displayed -as octal escape sequences instead of caret escape sequences. +as octal escape sequences instead of caret escape sequences. (You can +also request that raw bytes be shown in hex, @pxref{Display Custom, +display-raw-bytes-as-hex}.) @vindex nobreak-char-display @cindex non-breaking space diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index c1420ea13ff..c9c175d51e8 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -126,7 +126,7 @@ see which mode is actually being entered. Mode hooks are commonly used to enable minor modes (@pxref{Minor Modes}). For example, you can put the following lines in your init file to enable Flyspell minor mode in all text-based major modes -(@pxref{Spelling}), and Eldoc minor mode in Emacs Lisp mode +(@pxref{Spelling}), and ElDoc minor mode in Emacs Lisp mode (@pxref{Lisp Doc}): @example diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 373c7b55817..6eff0ca0d22 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -192,7 +192,7 @@ What keys to type to input the character in the current input method @item The character's encodings, both internally in the buffer, and externally -if you were to save the file. +if you were to save the buffer to a file. @item If you are running Emacs on a graphical display, the font name and @@ -200,6 +200,12 @@ glyph code for the character. If you are running Emacs on a text terminal, the code(s) sent to the terminal. @item +If the character was composed on display with any following characters +to form one or more grapheme clusters, the composition information: +the font glyphs if the frame is on a graphical display, and the +characters that were composed. + +@item The character's text properties (@pxref{Text Properties,,, elisp, the Emacs Lisp Reference Manual}), including any non-default faces used to display the character, and any overlays containing it diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 865a3a67d56..1c33d7dccc7 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1260,30 +1260,32 @@ the WoMan Info manual, which is distributed with Emacs. to view the built-in documentation for the Lisp functions and variables that you want to use. @xref{Name Help}. -@cindex Eldoc mode +@cindex ElDoc mode @findex eldoc-mode @findex global-eldoc-mode - Eldoc is a buffer-local minor mode that helps with looking up Lisp + ElDoc is a buffer-local minor mode that helps with looking up Lisp documentation. When it is enabled, the echo area displays some useful information whenever there is a Lisp function or variable at point; for a function, it shows the argument list, and for a variable it shows the first line of the variable's documentation string. To -toggle Eldoc mode, type @kbd{M-x eldoc-mode}. There's also a Global -Eldoc mode, which is turned on by default, and affects buffers whose +toggle ElDoc mode, type @kbd{M-x eldoc-mode}. There's also a Global +ElDoc mode, which is turned on by default, and affects buffers whose major mode sets the variables described below. Use @w{@kbd{M-x global-eldoc-mode}} to turn it off globally. -@vindex eldoc-documentation-function +@vindex eldoc-documentation-strategy @vindex eldoc-documentation-functions These variables can be used to configure ElDoc mode: @table @code -@item eldoc-documentation-function +@item eldoc-documentation-strategy This variable holds the function which is used to retrieve documentation for the item at point from the functions in the hook @code{eldoc-documentation-functions}. By default, -@code{eldoc-documentation-function} returns the first documentation -string produced by the @code{eldoc-documentation-functions} hook. +@code{eldoc-documentation-strategy} returns the first documentation +string produced by the @code{eldoc-documentation-functions} hook, but +it may be customized to compose those functions' results in other +ways. @item eldoc-documentation-functions This abnormal hook holds documentation functions. It acts as a diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 6fff199485e..25eabd6c3fc 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4274,9 +4274,16 @@ a display specification has the form @noindent @var{fringe} is either the symbol @code{left-fringe} or @code{right-fringe}. @var{bitmap} is a symbol identifying the bitmap -to display. The optional @var{face} names a face whose foreground -color is used to display the bitmap; this face is automatically merged -with the @code{fringe} face. +to display. The optional @var{face} names a face whose foreground and +background colors are to be used to display the bitmap, using the +attributes of the @code{fringe} face for colors that @var{face} didn't +specify. If @var{face} is omitted, that means to use the attributes +of the @code{default} face for the colors which the @code{fringe} face +didn't specify. For predictable results that don't depend on the +attributes of the @code{default} and @code{fringe} faces, we recommend +you never omit @var{face}, but always provide a specific face. In +particular, if you want the bitmap to be always displayed in the +@code{fringe} face, use @code{fringe} as @var{face}. For instance, to display an arrow in the left fringe, using the @code{warning} face, you could say something like: @@ -4980,8 +4987,9 @@ Margins}). This display specification on any character of a line of text causes the specified @var{bitmap} be displayed in the left or right fringes for that line, instead of the characters that have the display -specification. The optional @var{face} specifies the colors to be -used for the bitmap. @xref{Fringe Bitmaps}, for the details. +specification. The optional @var{face} specifies the face whose +colors are to be used for the bitmap display. @xref{Fringe Bitmaps}, +for the details. @item (space-width @var{factor}) This display specification affects all the space characters within the diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index a82b585d93d..22d32c00d9b 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1599,12 +1599,13 @@ parameters represent the user's stated preference; otherwise, use This parameter specifies a relative position of the frame's window-system window in the stacking (Z-) order of the frame's display. -If this is @code{above}, the frame's window-system window is displayed -above all other window-system windows that do not have the @code{above} -property set. If this is @code{nil}, the frame's window is displayed below all -windows that have the @code{above} property set and above all windows -that have the @code{below} property set. If this is @code{below}, the -frame's window is displayed below all windows that do not have the +If this is @code{above}, the window-system will display the window +that corresponds to the frame above all other window-system windows +that do not have the @code{above} property set. If this is +@code{nil}, the frame's window is displayed below all windows that +have the @code{above} property set and above all windows that have the +@code{below} property set. If this is @code{below}, the frame's +window is displayed below all windows that do not have the @code{below} property set. To position the frame above or below a specific other frame use the diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index eaee56f0a32..33a07c9fb4d 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -469,9 +469,10 @@ variable @code{imenu-generic-expression}, for the two variables @code{imenu-create-index-function} (@pxref{Imenu}). @item -The mode can specify a local value for -@code{eldoc-documentation-function} to tell ElDoc mode how to handle -this mode. +The mode can tell ElDoc mode how to retrieve different types of +documentation for whatever is at point, by adding one or more +buffer-local entries to the special hook +@code{eldoc-documentation-functions}. @item The mode can specify how to complete various keywords by adding one or diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 4002b36ce50..f018ef4c7c0 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -227,6 +227,9 @@ you are using. On all computers supported by Emacs, this is and is discussed further in David Goldberg's paper ``@url{https://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html, What Every Computer Scientist Should Know About Floating-Point Arithmetic}''. +On modern platforms, floating-point operations follow the IEEE-754 +standard closely; however, results are not always rounded correctly on +some obsolescent platforms, notably 32-bit x86. The read syntax for floating-point numbers requires either a decimal point, an exponent, or both. Optional signs (@samp{+} or @samp{-}) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 91894522300..942bda105f7 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -707,6 +707,10 @@ the Emacs process. (This is useful primarily in batch operation; see If @var{exit-data} is a string, its contents are stuffed into the terminal input buffer so that the shell (or whatever program next reads input) can read them. + +If @var{exit-data} is neither an integer nor a string, or is omitted, +that means to use the (system-specific) exit status which indicates +successful program termination. @end deffn @cindex SIGTERM diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 22c50936185..4002004cd6f 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2511,7 +2511,10 @@ If non-@code{nil}, always ask for the server's capabilities, even when doing a @samp{plain} connection. @item :capability-command @var{capability-command} -Command string to query the host capabilities. +Command to query the host capabilities. This can either be a string +(which will then be sent verbatim to the server), or a function +(called with a single parameter; the "greeting" from the server when +connecting), and should return a string. @item :end-of-command @var{regexp} @itemx :end-of-capability @var{regexp} diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 2ef88b90254..8de6255478b 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -248,7 +248,7 @@ properties removed. @defun concat &rest sequences @cindex copying strings @cindex concatenating strings -This function returns a new string consisting of the characters in the +This function returns a string consisting of the characters in the arguments passed to it (along with their text properties, if any). The arguments may be strings, lists of numbers, or vectors of numbers; they are not themselves changed. If @code{concat} receives no arguments, it @@ -269,9 +269,14 @@ returns an empty string. @end example @noindent -This function always constructs a new string that is not @code{eq} to -any existing string, except when the result is the empty string (to -save space, Emacs makes only one empty multibyte string). +This function does not always allocate a new string. Callers are +advised not rely on the result being a new string nor on it being +@code{eq} to an existing string. + +In particular, mutating the returned value may inadvertently change +another string, alter a constant string in the program, or even raise +an error. To obtain a string that you can safely mutate, use +@code{copy-sequence} on the result. For information about other concatenation functions, see the description of @code{mapconcat} in @ref{Mapping Functions}, diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index 49b6b53c0c4..fa1833a3da6 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -337,7 +337,8 @@ Verify OpenPGP cleartext signed messages in the current buffer. @kindex C-c C-e C-s @kindex C-c C-e s @findex epa-mail-sign -Compose a signed message from the current buffer. +Compose a signed message from the current buffer, using your default +key. With a prefix argument, select the key to use interactively. @item C-c C-e C-e and C-c C-e e @kindex C-c C-e C-e @@ -352,6 +353,8 @@ key in the recipient list, use @samp{encrypt-to} option in addresses using the @code{epa-mail-aliases} list. You can also use that option to ignore specific recipients for encryption purposes. +With prefix argument, asks you to select the recipients interactively, +whether to sign, and which key(s) to sign with. @end table @node Encrypting/decrypting gpg files, , Mail-mode integration, Commands diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index 701340ed6e2..4ead6032b74 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -83,6 +83,8 @@ Currently supported back-ends are: LDAP, Lightweight Directory Access Protocol @item BBDB, Big Brother's Insidious Database +@item +macOS Contacts @end itemize The main features of the EUDC interface are: @@ -107,6 +109,7 @@ Interface to BBDB to let you insert server records into your own BBDB database @menu * LDAP:: What is LDAP ? * BBDB:: What is BBDB ? +* macOS Contacts:: What is macOS Contacts ? @end menu @@ -159,6 +162,21 @@ queries on multiple servers. EUDC also offers a means to insert results from directory queries into your own local BBDB (@pxref{Creating BBDB Records}) + +@node macOS Contacts +@section macOS Contacts + +macOS Contacts is the rolodex-like application that ships with the +macOS operating system@footnote{Apple have changed the names of their +operating system and some applications over time. macOS used to be +called Mac OS X in the past, and the Contacts application was +previously called Address Book.}. + +EUDC considers macOS Contacts as a directory server back end just like +LDAP, though the macOS Contacts application always resides locally on +your machine. + + @node Installation @chapter Installation @@ -185,6 +203,7 @@ email composition buffers (@pxref{Inline Query Expansion}) @menu * LDAP Configuration:: EUDC needs external support for LDAP +* macOS Contacts Configuration:: Enable the macOS Contacts backend @end menu @node LDAP Configuration @@ -379,6 +398,39 @@ The @command{ldapsearch} command is formatted such that it can be copied and pasted into a terminal. Set the @command{ldapsearch} debug level to 5 by appending @code{-d 5} to the command line. + +@node macOS Contacts Configuration +@section macOS Contacts Configuration + +macOS Contacts support is added by means of @file{eudcb-mab.el}, or +@file{eudcb-macos-contacts.el} which are part of Emacs. + +To enable a macOS Contacts backend, first `require' the respective +library to load it, and then set the `eudc-server' to localhost in +your init file: +@lisp +(require 'eudcb-macos-contacts) +(eudc-macos-contacts-set-server "localhost") +@end lisp + +@file{eudcb-macos-contacts.el} uses the public scripting interfaces +offered by the Contacts app via the macOS Open Scripting Architecture +(OSA). To accomplish this, @file{eudcb-macos-contacts.el} uses an +external command line utility named osascript, which is included with +all macOS versions since 10.0 (which was released 2001). +@file{eudcb-macos-contacts.el} is hence recommended for all new +configurations. + +@file{eudcb-mab.el} reverse engineers the format of the database file +used by the macOS Contacts app, and accesses its contents directly. +While this may promise some performance advantages, it comes at the +cost of using an undocumented interface. Hence, users of +@file{eudcb-mab.el} are recommended to double check the compatibility +of @file{eudcb-mab.el} before upgrading to a new version of macOS. +@file{eudcb-mab.el} is retained for backwards compatibility with +existing configurations, and may be removed in a future release. + + @node Usage @chapter Usage diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index e3191cbe48a..9bca0faa854 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -283,6 +283,14 @@ contrast. If that is still too low for you, you can customize the variables @code{shr-color-visible-distance-min} and @code{shr-color-visible-luminance-min} to get a better contrast. +@vindex shr-max-width +@vindex shr-width + By default, the max width used when rendering is 120 characters, but +this can be adjusted by changing the @code{shr-max-width} variable. +If a specified width is preferred no matter what the width of the +window is, @code{shr-width} can be set. If both variables are +@code{nil}, the window width will always be used. + @vindex shr-discard-aria-hidden @cindex @code{aria-hidden}, HTML attribute The HTML attribute @code{aria-hidden} is meant to tell screen diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 718e269fc86..2f4bc0cbf85 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -436,7 +436,7 @@ Starting Gnus * Finding the News:: Choosing a method for getting news. * The Server is Down:: How can I read my mail then? -* Slave Gnusae:: You can have more than one Gnus active at a time. +* Child Gnusae:: You can have more than one Gnus active at a time. * Fetching a Group:: Starting Gnus just to read a group. * New Groups:: What is Gnus supposed to do with new groups? * Changing Servers:: You may want to move from one server to another. @@ -976,7 +976,7 @@ terminology section (@pxref{Terminology}). @menu * Finding the News:: Choosing a method for getting news. * The Server is Down:: How can I read my mail then? -* Slave Gnusae:: You can have more than one Gnus active at a time. +* Child Gnusae:: You can have more than one Gnus active at a time. * New Groups:: What is Gnus supposed to do with new groups? * Changing Servers:: You may want to move from one server to another. * Startup Files:: Those pesky startup files---@file{.newsrc}. @@ -1090,9 +1090,9 @@ your primary server---instead, it will just activate all groups on level levels.) Also @pxref{Group Levels}. -@node Slave Gnusae -@section Slave Gnusae -@cindex slave +@node Child Gnusae +@section Child Gnusae +@cindex child You might want to run more than one Emacs with more than one Gnus at the same time. If you are using different @file{.newsrc} files (e.g., if you @@ -1103,31 +1103,27 @@ The problem appears when you want to run two Gnusae that use the same @file{.newsrc} file. To work around that problem some, we here at the Think-Tank at the Gnus -Towers have come up with a new concept: @dfn{Masters} and -@dfn{slaves}. (We have applied for a patent on this concept, and have -taken out a copyright on those words. If you wish to use those words in -conjunction with each other, you have to send $1 per usage instance to -me. Usage of the patent (@dfn{Master/Slave Relationships In Computer -Applications}) will be much more expensive, of course.) - -@findex gnus-slave +Towers have come up with a new concept: @dfn{Parents} and +@dfn{children}. + +@findex gnus-child Anyway, you start one Gnus up the normal way with @kbd{M-x gnus} (or -however you do it). Each subsequent slave Gnusae should be started with -@kbd{M-x gnus-slave}. These slaves won't save normal @file{.newsrc} -files, but instead save @dfn{slave files} that contain information only -on what groups have been read in the slave session. When a master Gnus -starts, it will read (and delete) these slave files, incorporating all -information from them. (The slave files will be read in the sequence +however you do it). Each subsequent child Gnusae should be started with +@kbd{M-x gnus-child}. These children won't save normal @file{.newsrc} +files, but instead save @dfn{child files} that contain information only +on what groups have been read in the child session. When a parent Gnus +starts, it will read (and delete) these child files, incorporating all +information from them. (The child files will be read in the sequence they were created, so the latest changes will have precedence.) -Information from the slave files has, of course, precedence over the -information in the normal (i.e., master) @file{.newsrc} file. +Information from the child files has, of course, precedence over the +information in the normal (i.e., parent) @file{.newsrc} file. -If the @file{.newsrc*} files have not been saved in the master when the -slave starts, you may be prompted as to whether to read an auto-save -file. If you answer ``yes'', the unsaved changes to the master will be -incorporated into the slave. If you answer ``no'', the slave may see some -messages as unread that have been read in the master. +If the @file{.newsrc*} files have not been saved in the parent when the +child starts, you may be prompted as to whether to read an auto-save +file. If you answer ``yes'', the unsaved changes to the parent will be +incorporated into the child. If you answer ``no'', the child may see some +messages as unread that have been read in the parent. @@ -9064,6 +9060,9 @@ when filling. @findex gnus-article-fill-long-lines Fill long lines (@code{gnus-article-fill-long-lines}). +You can give the command a numerical prefix to specify the width to use +when filling. + @item W C @kindex W C @r{(Summary)} @findex gnus-article-capitalize-sentences @@ -28487,9 +28486,9 @@ entry. The format spec @code{%C} for positioning point has changed to @code{%*}. @item -@code{gnus-slave-unplugged} +@code{gnus-child-unplugged} -A new command which starts Gnus offline in slave mode. +A new command which starts Gnus offline in child mode. @end itemize diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index feead3d0a76..c018033cdab 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1709,10 +1709,11 @@ Integration for LXD containers. A container is accessed via @item magit-tramp @cindex method @option{git} @cindex @option{git} method -Browing git repositories with @code{magit}. A versioned file is accessed via -@file{@trampfn{git,rev@@root-dir,/path/to/file}}. @samp{rev} is a git -revision, and @samp{root-dir} is a virtual host name for the root -directory, specified in @code{magit-tramp-hosts-alist}. +Browsing git repositories with @code{magit}. A versioned file is +accessed via @file{@trampfn{git,rev@@root-dir,/path/to/file}}. +@samp{rev} is a git revision, and @samp{root-dir} is a virtual host +name for the root directory, specified in +@code{magit-tramp-hosts-alist}. @item tramp-hdfs @cindex method @option{hdfs} @@ -207,6 +207,16 @@ Bookmark locations can refer to VC directory buffers. ** Gnus ++++ +*** The name of dependent Gnus sessions has changed from "slave" to "child". +The names of the commands 'gnus-slave', 'gnus-slave-no-server' and +'gnus-slave-unplugged' have changed to 'gnus-child', +'gnus-child-no-server' and 'gnus-child-unplugged' respectively. + ++++ +*** The 'W Q' summary mode command now takes a numerical prefix to +allow adjusting the fill width. + --- *** Change to default value of 'message-draft-headers' user option. The 'Date' symbol has been removed from the default value, meaning that @@ -247,14 +257,25 @@ supplied error message. +++ ** ElDoc -*** New hook 'eldoc-documentation-functions' to be used for registering -doc string functions. This makes the results of all doc string -functions accessible to the user through the existing single function hook -'eldoc-documentation-function'. - -*** 'eldoc-documentation-function' is now a user option. -Modes should use the new hook instead of this user option to register -their backends. +*** New hook 'eldoc-documentation-functions'. +This hook is intended to be used for registering doc string functions. +These functions don't need to produce the doc string right away, they +may arrange for it to be produced asynchronously. The results of all +doc string functions are accessible to the user through the existing +variable 'eldoc-documentation-strategy'. + +*** New user option 'eldoc-documentation-strategy'. +The built-in choices available for this user option let users compose +the results of 'eldoc-documentation-functions' in various ways, even +if some of those functions are sychronous and some asynchchronous. +The user option replaces 'eldoc-documentation-function', which is now +obsolete. + +*** 'eldoc-echo-area-use-multiline-p' is now handled by ElDoc. +The user option 'eldoc-echo-area-use-multiline-p' is now handled +by the ElDoc library itself. Functions in +'eldoc-documentation-functions' don't need to worry about consulting +it when producing a doc string. ** Eshell @@ -268,6 +289,13 @@ This allows users to use (define-key eshell-mode-map ...) as usual. Some modules have their own minor mode now to account for these changes. +** EUDC + ++++ +*** New macOS Contacts backend. +This backend works on newer versions of macOS and is generally +preferred over the eudcb-mab.el backend. + ** Tramp +++ @@ -452,6 +480,16 @@ This is still the case by default, but if you customize 'browse-url-mailto-function' or 'browse-url-handlers' to call some other function, it will now be called instead of the default. ++++ +*** New variable 'shr-max-width'. +If this variable is non-nil, and 'shr-width' is nil, then SHR will use +the value of 'shr-max-width' to limit the width of the rendered HTML. +The default is 120 characters, so even if you have very wide frames, +HTML text will be rendered more narrowly, which usually leads to a +more readable text. Set this variable to nil to get the previous +behavior of rendering as wide as the window-width allows. If +'shr-width' is non-nil, it overrides this variable. + ** EWW --- @@ -524,13 +562,14 @@ truncation, amongst other things. 'bug-reference-prog-mode' have been activated, their respective hook has been run and still 'bug-reference-bug-regexp' and 'bug-reference-url-format' aren't both set, it tries to guess -appropriate values for those two variables. There are two guessing +appropriate values for those two variables. There are three guessing mechanisms so far: based on version control information of the current -buffer's file, and based on newsgroup/mail-folder name and several -news and mail message headers in Gnus buffers. Both mechanisms are -extensible with custom rules, see the variables -'bug-reference-setup-from-vc-alist' and -'bug-reference-setup-from-mail-alist'. +buffer's file, based on newsgroup/mail-folder name and several news +and mail message headers in Gnus buffers, and based on IRC channel and +server in rcirc buffers. All mechanisms are extensible with custom +rules, see the variables 'bug-reference-setup-from-vc-alist', +'bug-reference-setup-from-mail-alist', and +'bug-reference-setup-from-irc-alist'. * New Modes and Packages in Emacs 28.1 @@ -652,6 +691,12 @@ for encoding and decoding without having to bind 'coding-system-for-{read,write}' or call 'set-process-coding-system'. +++ +** 'open-network-stream' can now take a :capability-command that's a function. +The function is called with the greeting from the server as its only +parameter, and allows sending different TLS capability commands to the +server based on that greeting. + ++++ ** 'open-gnutls-stream' now also accepts a ':coding' argument. +++ diff --git a/etc/NEWS.22 b/etc/NEWS.22 index 548a73a0be9..4df1792fbc7 100644 --- a/etc/NEWS.22 +++ b/etc/NEWS.22 @@ -5239,7 +5239,7 @@ has no effect on systems with case-insensitive file names. hooks. `run-mode-hooks' does this automatically. *** Major modes can define `eldoc-documentation-function' -locally to provide Eldoc functionality by some method appropriate to +locally to provide ElDoc functionality by some method appropriate to the language. *** Use the new function `run-mode-hooks' to run the major mode's mode hook. diff --git a/etc/NEWS.23 b/etc/NEWS.23 index 9a49a7d4fcc..331ed281a37 100644 --- a/etc/NEWS.23 +++ b/etc/NEWS.23 @@ -1779,7 +1779,7 @@ to update it to the new VC. If `default-directory' is a remote file name, subprocesses are started on the corresponding remote system. -*** Eldoc highlights the function argument under point +*** ElDoc highlights the function argument under point with the face `eldoc-highlight-function-argument'. *** In Etags, the --members option is now the default. diff --git a/etc/NEWS.27 b/etc/NEWS.27 index 10a6e3946e7..2c8fa9dd397 100644 --- a/etc/NEWS.27 +++ b/etc/NEWS.27 @@ -270,7 +270,7 @@ doing before changing the value. +++ ** Native GnuTLS connections can now use client certificates. Previously, this support was only available when using the external -'gnutls-cli' command. Call 'open-network-stream' with +'gnutls-cli' or 'starttls' command. Call 'open-network-stream' with ':client-certificate t' to trigger looking up of per-server certificates via 'auth-source'. diff --git a/lib/alloca.in.h b/lib/alloca.in.h index c7187e66ae3..5686b082bbe 100644 --- a/lib/alloca.in.h +++ b/lib/alloca.in.h @@ -35,13 +35,16 @@ */ #ifndef alloca + /* Some version of mingw have an <alloca.h> that causes trouble when + included after 'alloca' gets defined as a macro. As a workaround, + include this <alloca.h> first and define 'alloca' as a macro afterwards + if needed. */ +# if defined __GNUC__ && (defined _WIN32 && ! defined __CYGWIN__) && @HAVE_ALLOCA_H@ +# include_next <alloca.h> +# endif +#endif +#ifndef alloca # ifdef __GNUC__ - /* Some version of mingw have an <alloca.h> that causes trouble when - included after 'alloca' gets defined as a macro. As a workaround, include - this <alloca.h> first and define 'alloca' as a macro afterwards. */ -# if (defined _WIN32 && ! defined __CYGWIN__) && @HAVE_ALLOCA_H@ -# include_next <alloca.h> -# endif # define alloca __builtin_alloca # elif defined _AIX # define alloca __alloca diff --git a/lib/dup2.c b/lib/dup2.c index 88ef2591313..9bc3951f3d2 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -25,28 +25,26 @@ #include <errno.h> #include <fcntl.h> -#if HAVE_DUP2 +#undef dup2 -# undef dup2 - -# if defined _WIN32 && ! defined __CYGWIN__ +#if defined _WIN32 && ! defined __CYGWIN__ /* Get declarations of the native Windows API functions. */ -# define WIN32_LEAN_AND_MEAN -# include <windows.h> +# define WIN32_LEAN_AND_MEAN +# include <windows.h> -# if HAVE_MSVC_INVALID_PARAMETER_HANDLER -# include "msvc-inval.h" -# endif +# if HAVE_MSVC_INVALID_PARAMETER_HANDLER +# include "msvc-inval.h" +# endif /* Get _get_osfhandle. */ -# if GNULIB_MSVC_NOTHROW -# include "msvc-nothrow.h" -# else -# include <io.h> -# endif +# if GNULIB_MSVC_NOTHROW +# include "msvc-nothrow.h" +# else +# include <io.h> +# endif -# if HAVE_MSVC_INVALID_PARAMETER_HANDLER +# if HAVE_MSVC_INVALID_PARAMETER_HANDLER static int dup2_nothrow (int fd, int desired_fd) { @@ -65,9 +63,9 @@ dup2_nothrow (int fd, int desired_fd) return result; } -# else -# define dup2_nothrow dup2 -# endif +# else +# define dup2_nothrow dup2 +# endif static int ms_windows_dup2 (int fd, int desired_fd) @@ -103,11 +101,11 @@ ms_windows_dup2 (int fd, int desired_fd) return result; } -# define dup2 ms_windows_dup2 +# define dup2 ms_windows_dup2 -# elif defined __KLIBC__ +#elif defined __KLIBC__ -# include <InnoTekLIBC/backend.h> +# include <InnoTekLIBC/backend.h> static int klibc_dup2dirfd (int fd, int desired_fd) @@ -155,81 +153,37 @@ klibc_dup2 (int fd, int desired_fd) return dupfd; } -# define dup2 klibc_dup2 -# endif +# define dup2 klibc_dup2 +#endif int rpl_dup2 (int fd, int desired_fd) { int result; -# ifdef F_GETFL +#ifdef F_GETFL /* On Linux kernels 2.6.26-2.6.29, dup2 (fd, fd) returns -EBADF. On Cygwin 1.5.x, dup2 (1, 1) returns 0. On Cygwin 1.7.17, dup2 (1, -1) dumps core. On Cygwin 1.7.25, dup2 (1, 256) can dump core. On Haiku, dup2 (fd, fd) mistakenly clears FD_CLOEXEC. */ -# if HAVE_SETDTABLESIZE +# if HAVE_SETDTABLESIZE setdtablesize (desired_fd + 1); -# endif +# endif if (desired_fd < 0) fd = desired_fd; if (fd == desired_fd) return fcntl (fd, F_GETFL) == -1 ? -1 : fd; -# endif +#endif result = dup2 (fd, desired_fd); /* Correct an errno value on FreeBSD 6.1 and Cygwin 1.5.x. */ if (result == -1 && errno == EMFILE) errno = EBADF; -# if REPLACE_FCHDIR +#if REPLACE_FCHDIR if (fd != desired_fd && result != -1) result = _gl_register_dup (fd, result); -# endif - return result; -} - -#else /* !HAVE_DUP2 */ - -/* On older platforms, dup2 did not exist. */ - -# ifndef F_DUPFD -static int -dupfd (int fd, int desired_fd) -{ - int duplicated_fd = dup (fd); - if (duplicated_fd < 0 || duplicated_fd == desired_fd) - return duplicated_fd; - else - { - int r = dupfd (fd, desired_fd); - int e = errno; - close (duplicated_fd); - errno = e; - return r; - } -} -# endif - -int -dup2 (int fd, int desired_fd) -{ - int result = fcntl (fd, F_GETFL) < 0 ? -1 : fd; - if (result == -1 || fd == desired_fd) - return result; - close (desired_fd); -# ifdef F_DUPFD - result = fcntl (fd, F_DUPFD, desired_fd); -# if REPLACE_FCHDIR - if (0 <= result) - result = _gl_register_dup (fd, result); -# endif -# else - result = dupfd (fd, desired_fd); -# endif - if (result == -1 && (errno == EMFILE || errno == EINVAL)) - errno = EBADF; +#endif return result; } -#endif /* !HAVE_DUP2 */ diff --git a/lib/getrandom.c b/lib/getrandom.c index 030a78bb08d..f8695abf30a 100644 --- a/lib/getrandom.c +++ b/lib/getrandom.c @@ -32,7 +32,7 @@ # if HAVE_BCRYPT_H # include <bcrypt.h> # else -# include <ntdef.h> /* NTSTATUS */ +# define NTSTATUS LONG typedef void * BCRYPT_ALG_HANDLE; # define BCRYPT_USE_SYSTEM_PREFERRED_RNG 0x00000002 # if HAVE_LIB_BCRYPT diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 35d2db09bd4..68cae8faf74 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -117,6 +117,7 @@ # ignore-value \ # intprops \ # largefile \ +# libgmp \ # lstat \ # manywarnings \ # memmem-simple \ @@ -245,14 +246,14 @@ GL_GENERATE_ALLOCA_H = @GL_GENERATE_ALLOCA_H@ GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@ GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@ GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@ +GL_GENERATE_GMP_H = @GL_GENERATE_GMP_H@ GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@ GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@ GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@ GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@ GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@ GMALLOC_OBJ = @GMALLOC_OBJ@ -GMP_LIB = @GMP_LIB@ -GMP_OBJ = @GMP_OBJ@ +GMP_H = @GMP_H@ GNULIB_ACCESS = @GNULIB_ACCESS@ GNULIB_ALPHASORT = @GNULIB_ALPHASORT@ GNULIB_ATOLL = @GNULIB_ATOLL@ @@ -325,6 +326,7 @@ GNULIB_GETPASS = @GNULIB_GETPASS@ GNULIB_GETRANDOM = @GNULIB_GETRANDOM@ GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@ GNULIB_GETTIMEOFDAY = @GNULIB_GETTIMEOFDAY@ +GNULIB_GETUMASK = @GNULIB_GETUMASK@ GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@ GNULIB_GL_UNISTD_H_GETOPT = @GNULIB_GL_UNISTD_H_GETOPT@ GNULIB_GRANTPT = @GNULIB_GRANTPT@ @@ -548,7 +550,6 @@ HAVE_DECL_UNSETENV = @HAVE_DECL_UNSETENV@ HAVE_DECL_VSNPRINTF = @HAVE_DECL_VSNPRINTF@ HAVE_DIRENT_H = @HAVE_DIRENT_H@ HAVE_DPRINTF = @HAVE_DPRINTF@ -HAVE_DUP2 = @HAVE_DUP2@ HAVE_DUP3 = @HAVE_DUP3@ HAVE_EUIDACCESS = @HAVE_EUIDACCESS@ HAVE_EXPLICIT_BZERO = @HAVE_EXPLICIT_BZERO@ @@ -578,6 +579,7 @@ HAVE_GETPASS = @HAVE_GETPASS@ HAVE_GETRANDOM = @HAVE_GETRANDOM@ HAVE_GETSUBOPT = @HAVE_GETSUBOPT@ HAVE_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@ +HAVE_GETUMASK = @HAVE_GETUMASK@ HAVE_GRANTPT = @HAVE_GRANTPT@ HAVE_GROUP_MEMBER = @HAVE_GROUP_MEMBER@ HAVE_IMAXDIV_T = @HAVE_IMAXDIV_T@ @@ -592,7 +594,6 @@ HAVE_MAKEINFO = @HAVE_MAKEINFO@ HAVE_MAX_ALIGN_T = @HAVE_MAX_ALIGN_T@ HAVE_MBSLEN = @HAVE_MBSLEN@ HAVE_MBTOWC = @HAVE_MBTOWC@ -HAVE_MEMCHR = @HAVE_MEMCHR@ HAVE_MEMPCPY = @HAVE_MEMPCPY@ HAVE_MKDIRAT = @HAVE_MKDIRAT@ HAVE_MKDTEMP = @HAVE_MKDTEMP@ @@ -760,6 +761,7 @@ LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ LIB_EACCESS = @LIB_EACCESS@ LIB_EXECINFO = @LIB_EXECINFO@ LIB_GETRANDOM = @LIB_GETRANDOM@ +LIB_GMP = @LIB_GMP@ LIB_MATH = @LIB_MATH@ LIB_PTHREAD = @LIB_PTHREAD@ LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@ @@ -1132,7 +1134,6 @@ pdfdir = @pdfdir@ prefix = @prefix@ program_transform_name = @program_transform_name@ psdir = @psdir@ -runstatedir = @runstatedir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ @@ -2015,6 +2016,29 @@ EXTRA_DIST += cdefs.h libc-config.h endif ## end gnulib module libc-config +## begin gnulib module libgmp +ifeq (,$(OMIT_GNULIB_MODULE_libgmp)) + +BUILT_SOURCES += $(GMP_H) + +# Build gmp.h as a wrapper for mini-gmp.h when using mini-gmp. +ifneq (,$(GL_GENERATE_GMP_H)) +gmp.h: $(top_builddir)/config.status + echo '#include "mini-gmp.h"' >$@-t + mv $@-t $@ +else +gmp.h: $(top_builddir)/config.status + rm -f $@ +endif +MOSTLYCLEANFILES += gmp.h gmp.h-t + +EXTRA_DIST += mini-gmp-gnulib.c mini-gmp.c mini-gmp.h + +EXTRA_libgnu_a_SOURCES += mini-gmp-gnulib.c mini-gmp.c + +endif +## end gnulib module libgmp + ## begin gnulib module limits-h ifeq (,$(OMIT_GNULIB_MODULE_limits-h)) @@ -2833,7 +2857,6 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \ -e 's|@''HAVE_FFSLL''@|$(HAVE_FFSLL)|g' \ -e 's|@''HAVE_MBSLEN''@|$(HAVE_MBSLEN)|g' \ - -e 's|@''HAVE_MEMCHR''@|$(HAVE_MEMCHR)|g' \ -e 's|@''HAVE_DECL_MEMMEM''@|$(HAVE_DECL_MEMMEM)|g' \ -e 's|@''HAVE_MEMPCPY''@|$(HAVE_MEMPCPY)|g' \ -e 's|@''HAVE_DECL_MEMRCHR''@|$(HAVE_DECL_MEMRCHR)|g' \ @@ -3017,6 +3040,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU -e 's/@''GNULIB_FSTAT''@/$(GNULIB_FSTAT)/g' \ -e 's/@''GNULIB_FSTATAT''@/$(GNULIB_FSTATAT)/g' \ -e 's/@''GNULIB_FUTIMENS''@/$(GNULIB_FUTIMENS)/g' \ + -e 's/@''GNULIB_GETUMASK''@/$(GNULIB_GETUMASK)/g' \ -e 's/@''GNULIB_LCHMOD''@/$(GNULIB_LCHMOD)/g' \ -e 's/@''GNULIB_LSTAT''@/$(GNULIB_LSTAT)/g' \ -e 's/@''GNULIB_MKDIRAT''@/$(GNULIB_MKDIRAT)/g' \ @@ -3030,6 +3054,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU -e 's|@''HAVE_FCHMODAT''@|$(HAVE_FCHMODAT)|g' \ -e 's|@''HAVE_FSTATAT''@|$(HAVE_FSTATAT)|g' \ -e 's|@''HAVE_FUTIMENS''@|$(HAVE_FUTIMENS)|g' \ + -e 's|@''HAVE_GETUMASK''@|$(HAVE_GETUMASK)|g' \ -e 's|@''HAVE_LCHMOD''@|$(HAVE_LCHMOD)|g' \ -e 's|@''HAVE_LSTAT''@|$(HAVE_LSTAT)|g' \ -e 's|@''HAVE_MKDIRAT''@|$(HAVE_MKDIRAT)|g' \ @@ -3338,7 +3363,6 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H < $(srcdir)/unistd.in.h | \ sed -e 's|@''HAVE_CHOWN''@|$(HAVE_CHOWN)|g' \ -e 's|@''HAVE_COPY_FILE_RANGE''@|$(HAVE_COPY_FILE_RANGE)|g' \ - -e 's|@''HAVE_DUP2''@|$(HAVE_DUP2)|g' \ -e 's|@''HAVE_DUP3''@|$(HAVE_DUP3)|g' \ -e 's|@''HAVE_EUIDACCESS''@|$(HAVE_EUIDACCESS)|g' \ -e 's|@''HAVE_FACCESSAT''@|$(HAVE_FACCESSAT)|g' \ diff --git a/lib/mini-gmp-gnulib.c b/lib/mini-gmp-gnulib.c new file mode 100644 index 00000000000..5019be5d52a --- /dev/null +++ b/lib/mini-gmp-gnulib.c @@ -0,0 +1,37 @@ +/* Tailor mini-gmp.c for Gnulib-using applications. + + Copyright 2018-2020 Free Software Foundation, Inc. + + This program 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 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/>. */ + +#include <config.h> + +#include <stddef.h> +#include <stdio.h> + +#include "mini-gmp.h" + +/* Pacify GCC -Wsuggest-attribute=const, malloc, pure. */ +#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) +# pragma GCC diagnostic ignored "-Wsuggest-attribute=const" +# pragma GCC diagnostic ignored "-Wsuggest-attribute=malloc" +# pragma GCC diagnostic ignored "-Wsuggest-attribute=pure" +#endif + +/* Pacify GCC -Wunused-variable for variables used only in 'assert' calls. */ +#if defined NDEBUG && 4 < __GNUC__ + (6 <= __GNUC_MINOR__) +# pragma GCC diagnostic ignored "-Wunused-variable" +#endif + +#include "mini-gmp.c" diff --git a/src/mini-gmp.c b/lib/mini-gmp.c index 2e789a2dfcc..2e0301b0081 100644 --- a/src/mini-gmp.c +++ b/lib/mini-gmp.c @@ -2,21 +2,21 @@ Contributed to the GNU project by Niels Möller -Copyright 1991-1997, 1999-2019 Free Software Foundation, Inc. +Copyright 1991-1997, 1999-2020 Free Software Foundation, Inc. This file is part of the GNU MP Library. The GNU MP Library is free software; you can redistribute it and/or modify it under the terms of either: - * the GNU Lesser General Public License as published by the Free + * 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. or * the GNU General Public License as published by the Free Software - Foundation; either version 2 of the License, or (at your option) any + Foundation; either version 3 of the License, or (at your option) any later version. or both in parallel, as here. @@ -27,7 +27,7 @@ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received copies of the GNU General Public License and the -GNU Lesser General Public License along with the GNU MP Library. If not, +GNU General Public License along with the GNU MP Library. If not, see https://www.gnu.org/licenses/. */ /* NOTE: All functions in this file which are not declared in @@ -351,20 +351,27 @@ mp_set_memory_functions (void *(*alloc_func) (size_t), gmp_free_func = free_func; } -#define gmp_xalloc(size) ((*gmp_allocate_func)((size))) -#define gmp_free(p) ((*gmp_free_func) ((p), 0)) +#define gmp_alloc(size) ((*gmp_allocate_func)((size))) +#define gmp_free(p, size) ((*gmp_free_func) ((p), (size))) +#define gmp_realloc(ptr, old_size, size) ((*gmp_reallocate_func)(ptr, old_size, size)) static mp_ptr -gmp_xalloc_limbs (mp_size_t size) +gmp_alloc_limbs (mp_size_t size) { - return (mp_ptr) gmp_xalloc (size * sizeof (mp_limb_t)); + return (mp_ptr) gmp_alloc (size * sizeof (mp_limb_t)); } static mp_ptr -gmp_xrealloc_limbs (mp_ptr old, mp_size_t size) +gmp_realloc_limbs (mp_ptr old, mp_size_t old_size, mp_size_t size) { assert (size > 0); - return (mp_ptr) (*gmp_reallocate_func) (old, 0, size * sizeof (mp_limb_t)); + return (mp_ptr) gmp_realloc (old, old_size * sizeof (mp_limb_t), size * sizeof (mp_limb_t)); +} + +static void +gmp_free_limbs (mp_ptr old, mp_size_t size) +{ + gmp_free (old, size * sizeof (mp_limb_t)); } @@ -956,11 +963,17 @@ mpn_div_qr_1_preinv (mp_ptr qp, mp_srcptr np, mp_size_t nn, mp_limb_t d, di; mp_limb_t r; mp_ptr tp = NULL; + mp_size_t tn = 0; if (inv->shift > 0) { /* Shift, reusing qp area if possible. In-place shift if qp == np. */ - tp = qp ? qp : gmp_xalloc_limbs (nn); + tp = qp; + if (!tp) + { + tn = nn; + tp = gmp_alloc_limbs (tn); + } r = mpn_lshift (tp, np, nn, inv->shift); np = tp; } @@ -977,8 +990,8 @@ mpn_div_qr_1_preinv (mp_ptr qp, mp_srcptr np, mp_size_t nn, if (qp) qp[nn] = q; } - if ((inv->shift > 0) && (tp != qp)) - gmp_free (tp); + if (tn) + gmp_free_limbs (tp, tn); return r >> inv->shift; } @@ -1136,13 +1149,13 @@ mpn_div_qr (mp_ptr qp, mp_ptr np, mp_size_t nn, mp_srcptr dp, mp_size_t dn) mpn_div_qr_invert (&inv, dp, dn); if (dn > 2 && inv.shift > 0) { - tp = gmp_xalloc_limbs (dn); + tp = gmp_alloc_limbs (dn); gmp_assert_nocarry (mpn_lshift (tp, dp, dn, inv.shift)); dp = tp; } mpn_div_qr_preinv (qp, np, nn, dp, dn, &inv); if (tp) - gmp_free (tp); + gmp_free_limbs (tp, dn); } @@ -1428,14 +1441,14 @@ mpz_init2 (mpz_t r, mp_bitcnt_t bits) r->_mp_alloc = rn; r->_mp_size = 0; - r->_mp_d = gmp_xalloc_limbs (rn); + r->_mp_d = gmp_alloc_limbs (rn); } void mpz_clear (mpz_t r) { if (r->_mp_alloc) - gmp_free (r->_mp_d); + gmp_free_limbs (r->_mp_d, r->_mp_alloc); } static mp_ptr @@ -1444,9 +1457,9 @@ mpz_realloc (mpz_t r, mp_size_t size) size = GMP_MAX (size, 1); if (r->_mp_alloc) - r->_mp_d = gmp_xrealloc_limbs (r->_mp_d, size); + r->_mp_d = gmp_realloc_limbs (r->_mp_d, r->_mp_alloc, size); else - r->_mp_d = gmp_xalloc_limbs (size); + r->_mp_d = gmp_alloc_limbs (size); r->_mp_alloc = size; if (GMP_ABS (r->_mp_size) > size) @@ -1541,8 +1554,7 @@ mpz_init_set (mpz_t r, const mpz_t x) int mpz_fits_slong_p (const mpz_t u) { - return (LONG_MAX + LONG_MIN == 0 || mpz_cmp_ui (u, LONG_MAX) <= 0) && - mpz_cmpabs_ui (u, GMP_NEG_CAST (unsigned long int, LONG_MIN)) <= 0; + return mpz_cmp_si (u, LONG_MAX) <= 0 && mpz_cmp_si (u, LONG_MIN) >= 0; } static int @@ -1565,6 +1577,30 @@ mpz_fits_ulong_p (const mpz_t u) return us >= 0 && mpn_absfits_ulong_p (u->_mp_d, us); } +int +mpz_fits_sint_p (const mpz_t u) +{ + return mpz_cmp_si (u, INT_MAX) <= 0 && mpz_cmp_si (u, INT_MIN) >= 0; +} + +int +mpz_fits_uint_p (const mpz_t u) +{ + return u->_mp_size >= 0 && mpz_cmpabs_ui (u, UINT_MAX) <= 0; +} + +int +mpz_fits_sshort_p (const mpz_t u) +{ + return mpz_cmp_si (u, SHRT_MAX) <= 0 && mpz_cmp_si (u, SHRT_MIN) >= 0; +} + +int +mpz_fits_ushort_p (const mpz_t u) +{ + return u->_mp_size >= 0 && mpz_cmpabs_ui (u, USHRT_MAX) <= 0; +} + long int mpz_get_si (const mpz_t u) { @@ -3073,7 +3109,7 @@ mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const mpz_t m) one, using a *normalized* m. */ minv.shift = 0; - tp = gmp_xalloc_limbs (mn); + tp = gmp_alloc_limbs (mn); gmp_assert_nocarry (mpn_lshift (tp, mp, mn, shift)); mp = tp; } @@ -3139,7 +3175,7 @@ mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const mpz_t m) tr->_mp_size = mpn_normalized_size (tr->_mp_d, mn); } if (tp) - gmp_free (tp); + gmp_free_limbs (tp, mn); mpz_swap (r, tr); mpz_clear (tr); @@ -3350,13 +3386,15 @@ gmp_jacobi_coprime (mp_limb_t a, mp_limb_t b) gmp_ctz(c, a); a >>= 1; - do + for (;;) { a >>= c; /* (2/b) = -1 if b = 3 or 5 mod 8 */ bit ^= c & (b ^ (b >> 1)); if (a < b) { + if (a == 0) + return bit & 1 ? -1 : 1; bit ^= a & b; a = b - a; b -= a; @@ -3370,9 +3408,6 @@ gmp_jacobi_coprime (mp_limb_t a, mp_limb_t b) gmp_ctz(c, a); ++c; } - while (b > 0); - - return bit & 1 ? -1 : 1; } static void @@ -4144,7 +4179,7 @@ mpz_scan0 (const mpz_t u, mp_bitcnt_t starting_bit) size_t mpz_sizeinbase (const mpz_t u, int base) { - mp_size_t un; + mp_size_t un, tn; mp_srcptr up; mp_ptr tp; mp_bitcnt_t bits; @@ -4177,20 +4212,21 @@ mpz_sizeinbase (const mpz_t u, int base) 10. */ } - tp = gmp_xalloc_limbs (un); + tp = gmp_alloc_limbs (un); mpn_copyi (tp, up, un); mpn_div_qr_1_invert (&bi, base); + tn = un; ndigits = 0; do { ndigits++; - mpn_div_qr_1_preinv (tp, tp, un, &bi); - un -= (tp[un-1] == 0); + mpn_div_qr_1_preinv (tp, tp, tn, &bi); + tn -= (tp[tn-1] == 0); } - while (un > 0); + while (tn > 0); - gmp_free (tp); + gmp_free_limbs (tp, un); return ndigits; } @@ -4200,7 +4236,7 @@ mpz_get_str (char *sp, int base, const mpz_t u) unsigned bits; const char *digits; mp_size_t un; - size_t i, sn; + size_t i, sn, osn; digits = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; if (base > 1) @@ -4221,15 +4257,19 @@ mpz_get_str (char *sp, int base, const mpz_t u) sn = 1 + mpz_sizeinbase (u, base); if (!sp) - sp = (char *) gmp_xalloc (1 + sn); - + { + osn = 1 + sn; + sp = (char *) gmp_alloc (osn); + } + else + osn = 0; un = GMP_ABS (u->_mp_size); if (un == 0) { sp[0] = '0'; - sp[1] = '\0'; - return sp; + sn = 1; + goto ret; } i = 0; @@ -4248,17 +4288,20 @@ mpz_get_str (char *sp, int base, const mpz_t u) mp_ptr tp; mpn_get_base_info (&info, base); - tp = gmp_xalloc_limbs (un); + tp = gmp_alloc_limbs (un); mpn_copyi (tp, u->_mp_d, un); sn = i + mpn_get_str_other ((unsigned char *) sp + i, base, &info, tp, un); - gmp_free (tp); + gmp_free_limbs (tp, un); } for (; i < sn; i++) sp[i] = digits[(unsigned char) sp[i]]; +ret: sp[sn] = '\0'; + if (osn && osn != sn + 1) + sp = gmp_realloc(sp, osn, sn + 1); return sp; } @@ -4268,7 +4311,7 @@ mpz_set_str (mpz_t r, const char *sp, int base) unsigned bits, value_of_a; mp_size_t rn, alloc; mp_ptr rp; - size_t dn; + size_t dn, sn; int sign; unsigned char *dp; @@ -4306,7 +4349,8 @@ mpz_set_str (mpz_t r, const char *sp, int base) r->_mp_size = 0; return -1; } - dp = (unsigned char *) gmp_xalloc (strlen (sp)); + sn = strlen(sp); + dp = (unsigned char *) gmp_alloc (sn); value_of_a = (base > 36) ? 36 : 10; for (dn = 0; *sp; sp++) @@ -4326,7 +4370,7 @@ mpz_set_str (mpz_t r, const char *sp, int base) if (digit >= (unsigned) base) { - gmp_free (dp); + gmp_free (dp, sn); r->_mp_size = 0; return -1; } @@ -4336,7 +4380,7 @@ mpz_set_str (mpz_t r, const char *sp, int base) if (!dn) { - gmp_free (dp); + gmp_free (dp, sn); r->_mp_size = 0; return -1; } @@ -4360,7 +4404,7 @@ mpz_set_str (mpz_t r, const char *sp, int base) rn -= rp[rn-1] == 0; } assert (rn <= alloc); - gmp_free (dp); + gmp_free (dp, sn); r->_mp_size = sign ? - rn : rn; @@ -4378,13 +4422,13 @@ size_t mpz_out_str (FILE *stream, int base, const mpz_t x) { char *str; - size_t len; + size_t len, n; str = mpz_get_str (NULL, base, x); len = strlen (str); - len = fwrite (str, 1, len, stream); - gmp_free (str); - return len; + n = fwrite (str, 1, len, stream); + gmp_free (str, len + 1); + return n; } @@ -4512,7 +4556,7 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian, count = (k + (un-1) * sizeof (mp_limb_t) + size - 1) / size; if (!r) - r = gmp_xalloc (count * size); + r = gmp_alloc (count * size); if (endian == 0) endian = gmp_detect_endian (); diff --git a/src/mini-gmp.h b/lib/mini-gmp.h index 7cce3f7a328..c00568c2568 100644 --- a/src/mini-gmp.h +++ b/lib/mini-gmp.h @@ -7,14 +7,14 @@ This file is part of the GNU MP Library. The GNU MP Library is free software; you can redistribute it and/or modify it under the terms of either: - * the GNU Lesser General Public License as published by the Free + * 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. or * the GNU General Public License as published by the Free Software - Foundation; either version 2 of the License, or (at your option) any + Foundation; either version 3 of the License, or (at your option) any later version. or both in parallel, as here. @@ -25,7 +25,7 @@ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received copies of the GNU General Public License and the -GNU Lesser General Public License along with the GNU MP Library. If not, +GNU General Public License along with the GNU MP Library. If not, see https://www.gnu.org/licenses/. */ /* About mini-gmp: This is a minimal implementation of a subset of the @@ -244,6 +244,10 @@ mp_bitcnt_t mpz_scan1 (const mpz_t, mp_bitcnt_t); int mpz_fits_slong_p (const mpz_t); int mpz_fits_ulong_p (const mpz_t); +int mpz_fits_sint_p (const mpz_t); +int mpz_fits_uint_p (const mpz_t); +int mpz_fits_sshort_p (const mpz_t); +int mpz_fits_ushort_p (const mpz_t); long int mpz_get_si (const mpz_t); unsigned long int mpz_get_ui (const mpz_t); double mpz_get_d (const mpz_t); diff --git a/lib/string.in.h b/lib/string.in.h index a08e7057fbd..aa9802791ee 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -134,11 +134,6 @@ _GL_FUNCDECL_RPL (memchr, void *, (void const *__s, int __c, size_t __n) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (memchr, void *, (void const *__s, int __c, size_t __n)); # else -# if ! @HAVE_MEMCHR@ -_GL_FUNCDECL_SYS (memchr, void *, (void const *__s, int __c, size_t __n) - _GL_ATTRIBUTE_PURE - _GL_ARG_NONNULL ((1))); -# endif /* On some systems, this function is defined as an overloaded function: extern "C" { const void * std::memchr (const void *, int, size_t); } extern "C++" { void * std::memchr (void *, int, size_t); } */ diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index 44946072795..89e167f6d1c 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -515,6 +515,23 @@ _GL_WARN_ON_USE (futimens, "futimens is not portable - " #endif +#if @GNULIB_GETUMASK@ +# if !@HAVE_GETUMASK@ +_GL_FUNCDECL_SYS (getumask, mode_t, (void)); +# endif +_GL_CXXALIAS_SYS (getumask, mode_t, (void)); +# if @HAVE_GETUMASK@ +_GL_CXXALIASWARN (getumask); +# endif +#elif defined GNULIB_POSIXCHECK +# undef getumask +# if HAVE_RAW_DECL_GETUMASK +_GL_WARN_ON_USE (getumask, "getumask is not portable - " + "use gnulib module getumask for portability"); +# endif +#endif + + #if @GNULIB_LCHMOD@ /* Change the mode of FILENAME to MODE, without dereferencing it if FILENAME denotes a symbolic link. */ diff --git a/lib/unistd.in.h b/lib/unistd.in.h index b211e4d61f7..a81a14fe873 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -408,9 +408,6 @@ _GL_WARN_ON_USE (dup, "dup is unportable - " _GL_FUNCDECL_RPL (dup2, int, (int oldfd, int newfd)); _GL_CXXALIAS_RPL (dup2, int, (int oldfd, int newfd)); # else -# if !@HAVE_DUP2@ -_GL_FUNCDECL_SYS (dup2, int, (int oldfd, int newfd)); -# endif _GL_CXXALIAS_SYS (dup2, int, (int oldfd, int newfd)); # endif _GL_CXXALIASWARN (dup2); diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index fbdddca7d76..2a8dced5e9c 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -415,15 +415,17 @@ not altered with an escape sequence.") ;;;_ , Widget element formatting ;;;_ = allout-item-icon-keymap (defvar allout-item-icon-keymap - (let ((km (make-sparse-keymap))) + (let ((km (make-sparse-keymap)) + (as-parent (if (current-local-map) + (make-composed-keymap (current-local-map) + (current-global-map)) + (current-global-map)))) + ;; The keymap parent is reset on the each local var when mode starts. + (set-keymap-parent km as-parent) (dolist (digit '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")) (define-key km digit 'digit-argument)) (define-key km "-" 'negative-argument) -;; (define-key km [(return)] 'allout-tree-expand-command) -;; (define-key km [(meta return)] 'allout-toggle-torso-command) -;; (define-key km [(down-mouse-1)] 'allout-item-button-click) -;; (define-key km [(down-mouse-2)] 'allout-toggle-torso-event-command) ;; Override underlying mouse-1 and mouse-2 bindings in icon territory: (define-key km [(mouse-1)] (lambda () (interactive) nil)) (define-key km [(mouse-2)] (lambda () (interactive) nil)) @@ -433,17 +435,16 @@ not altered with an escape sequence.") km) "General tree-node key bindings.") +(make-variable-buffer-local 'allout-item-icon-keymap) ;;;_ = allout-item-body-keymap (defvar allout-item-body-keymap (let ((km (make-sparse-keymap)) - (local-map (current-local-map))) -;; (define-key km [(control return)] 'allout-tree-expand-command) -;; (define-key km [(meta return)] 'allout-toggle-torso-command) - ;; XXX We need to reset this per buffer's mode; we do so in - ;; allout-widgets-mode. - (if local-map - (set-keymap-parent km local-map)) - + (as-parent (if (current-local-map) + (make-composed-keymap (current-local-map) + (current-global-map)) + (current-global-map)))) + ;; The keymap parent is reset on the each local var when mode starts. + (set-keymap-parent km as-parent) km) "General key bindings for the text content of outline items.") (make-variable-buffer-local 'allout-item-body-keymap) @@ -456,6 +457,7 @@ not altered with an escape sequence.") (set-keymap-parent km allout-item-icon-keymap) km) "Keymap used in the item cue area - the space between the icon and headline.") +(make-variable-buffer-local 'allout-cue-span-keymap) ;;;_ = allout-escapes-category (defvar allout-escapes-category nil "Symbol for category of text property used to hide escapes of prefix-like @@ -566,8 +568,13 @@ outline hot-spot navigation (see `allout-mode')." (add-to-invisibility-spec '(allout-torso . t)) (add-to-invisibility-spec 'allout-escapes) - (if (current-local-map) - (set-keymap-parent allout-item-body-keymap (current-local-map))) + (let ((as-parent (if (current-local-map) + (make-composed-keymap (current-local-map) + (current-global-map)) + (current-global-map)))) + (set-keymap-parent allout-item-body-keymap as-parent) + ;; allout-cue-span-keymap uses allout-item-icon-keymap as parent. + (set-keymap-parent allout-item-icon-keymap as-parent)) (add-hook 'allout-exposure-change-functions 'allout-widgets-exposure-change-recorder nil 'local) @@ -677,7 +684,7 @@ outline hot-spot navigation (see `allout-mode')." (setplist 'allout-cue-span-category nil) (put 'allout-cue-span-category 'evaporate t) (put 'allout-cue-span-category - 'modification-hooks '(allout-body-modification-handler)) + 'modification-hooks '(allout-graphics-modification-handler)) (put 'allout-cue-span-category 'local-map allout-cue-span-keymap) (put 'allout-cue-span-category 'mouse-face widget-button-face) (put 'allout-cue-span-category 'pointer 'arrow) @@ -988,6 +995,7 @@ Generally invoked via `allout-exposure-change-functions'." ;; have to distinguish between concealing and exposing so that, eg, ;; `allout-expose-topic's mix is handled properly. handled-expose + handled-conceal covered deactivate-mark) @@ -1594,7 +1602,10 @@ We return the item-widget corresponding to the item at point." (if is-container (progn (widget-put item-widget :is-container t) (setq reverse-siblings-chart (list 1))) - (goto-char (widget-apply parent :actual-position :from)) + (let ((parent-position (widget-apply parent + :actual-position :from))) + (when parent-position + (goto-char parent-position))) (if (widget-get parent :is-container) ;; `allout-goto-prefix' will go to first non-container item: (allout-goto-prefix) @@ -1994,8 +2005,7 @@ reapplying this method will rectify the glyphs." ;; NOTE: most of the cue-area (when (not (widget-get item-widget :is-container)) - (let* ((cue-start (or (widget-get item-widget :distinctive-end) - (widget-get item-widget :icon-end))) + (let* ((cue-start (widget-get item-widget :icon-end)) (body-start (widget-get item-widget :body-start)) ;(expanded (widget-get item-widget :expanded)) ;(has-subitems (widget-get item-widget :has-subitems)) @@ -2050,19 +2060,22 @@ Optional FORCE means force reassignment of the region property." ;;;_ > allout-widgets-undecorate-region (start end) (defun allout-widgets-undecorate-region (start end) "Eliminate widgets and decorations for all items in region from START to END." - (let ((next start) - widget) + (let (done next widget + (end (or end (point-max)))) (save-excursion (goto-char start) - (while (< (setq next (next-single-char-property-change next - 'display - (current-buffer) - end)) - end) - (goto-char next) - (when (setq widget (allout-get-item-widget)) - ;; if the next-property/overly progression got us to a widget: - (allout-widgets-undecorate-item widget t)))))) + (while (not done) + (when (and (allout-on-current-heading-p) + (setq widget (allout-get-item-widget))) + (if widget + (allout-widgets-undecorate-item widget t))) + (goto-char (setq next + (next-single-char-property-change (point) + 'display + (current-buffer) + end))) + (if (>= next end) + (setq done t)))))) ;;;_ > allout-widgets-undecorate-text (text) (defun allout-widgets-undecorate-text (text) "Eliminate widgets and decorations for all items in TEXT." @@ -2389,7 +2402,7 @@ The elements of LIST are not copied, just the list structure itself." ;;;_ : provide (provide 'allout-widgets) -;;;_. Local emacs vars. -;;;_ , Local variables: -;;;_ , allout-layout: (-1 : 0) -;;;_ , End: +;;;_ . Local emacs vars. +;;;_ , Local variables: +;;;_ , allout-layout: (-1 : 0) +;;;_ , End: diff --git a/lisp/autorevert.el b/lisp/autorevert.el index e023c8fc7a6..6e08176f5ff 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -545,7 +545,7 @@ specifies in the mode line." ;; we wouldn't know when to revert it otherwise. (not (eq buffer-stale-function #'buffer-stale--default-function)))) - (not (memq 'major-mode global-auto-revert-ignore-modes)) + (not (memq major-mode global-auto-revert-ignore-modes)) (or (null global-auto-revert-ignore-buffer) (if (functionp global-auto-revert-ignore-buffer) (not (funcall global-auto-revert-ignore-buffer diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 5bb16981711..de7d60f97eb 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1774,7 +1774,8 @@ Bookmark names preceded by a \"*\" have annotations. \\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark in another buffer. \\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. -\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark." +\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark. +\\[bookmark-bmenu-search] -- incrementally search for bookmarks." (setq truncate-lines t) (setq buffer-read-only t)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 4e4fb671730..09b49621070 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -2429,7 +2429,7 @@ the United States." (if (and (memq last-command-event '(?@ ?o ?h ?\' ?m)) (string-match " " calc-hms-format)) (insert " ")) - (if (and (eq this-command last-command) + (if (and (memq last-command '(calcDigit-start calcDigit-key)) (eq last-command-event ?.)) (progn (require 'calc-ext) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 2c3b24b9b16..1ed18339a72 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1663,6 +1663,42 @@ Select the buffer containing the tag's definition, and move point there." (defvar semantic-grammar-eldoc-last-data (cons nil nil)) +(defun semantic--docstring-format-sym-doc (prefix doc &optional face) + "Combine PREFIX and DOC, and shorten the result to fit in the echo area. + +When PREFIX is a symbol, propertize its symbol name with FACE +before combining it with DOC. If FACE is not provided, just +apply the nil face. + +See also: `eldoc-echo-area-use-multiline-p'." + ;; Hoisted from old `eldoc-docstring-format-sym-doc'. + ;; If the entire line cannot fit in the echo area, the symbol name may be + ;; truncated or eliminated entirely from the output to make room for the + ;; description. + (when (symbolp prefix) + (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": "))) + (let* ((ea-multi eldoc-echo-area-use-multiline-p) + ;; Subtract 1 from window width since emacs will not write + ;; any chars to the last column, or in later versions, will + ;; cause a wraparound and resize of the echo area. + (ea-width (1- (window-width (minibuffer-window)))) + (strip (- (+ (length prefix) + (length doc)) + ea-width))) + (cond ((or (<= strip 0) + (eq ea-multi t) + (and ea-multi (> (length doc) ea-width))) + (concat prefix doc)) + ((> (length doc) ea-width) + (substring (format "%s" doc) 0 ea-width)) + ((>= strip (string-match-p ":? *\\'" prefix)) + doc) + (t + ;; Show the end of the partial symbol name, rather + ;; than the beginning, since the former is more likely + ;; to be unique given package namespace conventions. + (concat (substring prefix strip) doc))))) + (defun semantic-grammar-eldoc-get-macro-docstring (macro expander) "Return a one-line docstring for the given grammar MACRO. EXPANDER is the name of the function that expands MACRO." @@ -1681,19 +1717,18 @@ EXPANDER is the name of the function that expands MACRO." (setq doc (eldoc-function-argstring expander)))) (when doc (setq doc - (eldoc-docstring-format-sym-doc + (semantic--docstring-format-sym-doc macro (format "==> %s %s" expander doc) 'default)) (setq semantic-grammar-eldoc-last-data (cons expander doc))) doc)) ((fboundp 'elisp-get-fnsym-args-string) ;; Emacs≥25 - (elisp-get-fnsym-args-string - expander nil - (concat (propertize (symbol-name macro) + (concat (propertize (symbol-name macro) 'face 'font-lock-keyword-face) " ==> " (propertize (symbol-name macro) 'face 'font-lock-function-name-face) - ": "))))) + ": " + (elisp-get-fnsym-args-string expander nil ))))) (define-mode-local-override semantic-idle-summary-current-symbol-info semantic-grammar-mode () diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 1ec27085506..1942f25e891 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2102,11 +2102,12 @@ and `face'." (insert " ")) (widget-put widget :children children)))) -(defun custom-magic-reset (widget) +(defun custom-magic-reset (widget &optional buffer) "Redraw the :custom-magic property of WIDGET." (let ((magic (widget-get widget :custom-magic))) (when magic - (widget-value-set magic (widget-value magic))))) + (with-current-buffer (or buffer (current-buffer)) + (widget-value-set magic (widget-value magic)))))) ;;; The `custom' Widget. @@ -2217,7 +2218,7 @@ and `face'." ;; commands like `M-u' (that work on a region in the buffer) ;; will upcase the wrong part of the buffer, since more text has ;; been inserted before point. - (run-with-idle-timer 0.0 nil #'custom-magic-reset widget) + (run-with-idle-timer 0.0 nil #'custom-magic-reset widget (current-buffer)) (apply 'widget-default-notify widget args)))) (defun custom-redraw (widget) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 1dbbd421489..55f0b7dcb40 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -763,6 +763,8 @@ The character information includes: (to (nth 4 composition)) glyph) (if (fontp font) + ;; GUI frame: show composition in terms of + ;; font glyphs and characters. (progn (insert " using this font:\n " (symbol-name (font-get font :type)) @@ -772,12 +774,25 @@ The character information includes: (while (and (<= from to) (setq glyph (lgstring-glyph gstring from))) (insert (format " %S\n" glyph)) - (setq from (1+ from)))) + (setq from (1+ from))) + (when (and (stringp (car composition)) + (string-match "\"\\([^\"]+\\)\"" (car composition))) + (insert "with these character(s):\n") + (let ((chars (match-string 1 (car composition)))) + (dotimes (i (length chars)) + (let ((char (aref chars i))) + (insert (format " %s (#x%x) %s\n" + (describe-char-padded-string char) char + (get-char-code-property + char 'name)))))))) + ;; TTY frame: show composition in terms of characters. (insert " by these characters:\n") (while (and (<= from to) (setq glyph (lgstring-glyph gstring from))) - (insert (format " %c (#x%x)\n" - (lglyph-char glyph) (lglyph-char glyph))) + (insert (format " %c (#x%x) %s\n" + (lglyph-char glyph) (lglyph-char glyph) + (get-char-code-property + (lglyph-char glyph) 'name))) (setq from (1+ from))))) (insert " by the rule:\n\t(") (let ((first t)) @@ -919,7 +934,7 @@ condition, the function may return string longer than WIDTH, see (t name))))))) ;;;###autoload -(defun describe-char-eldoc () +(defun describe-char-eldoc (_callback &rest _) "Return a description of character at point for use by ElDoc mode. Return nil if character at point is a printable ASCII @@ -929,10 +944,17 @@ Otherwise return a description formatted by of `eldoc-echo-area-use-multiline-p' variable and width of minibuffer window for width limit. -This function is meant to be used as a value of -`eldoc-documentation-function' variable." +This function can be used as a value of +`eldoc-documentation-functions' variable." (let ((ch (following-char))) (when (and (not (zerop ch)) (or (< ch 32) (> ch 127))) + ;; TODO: investigate if the new `eldoc-documentation-functions' + ;; API could significantly improve this. JT@2020-07-07: Indeed, + ;; instead of returning a string tailored here for the echo area + ;; exclusively, we could call the (now unused) argument + ;; _CALLBACK with hints on how to shorten the string if needed, + ;; or with multiple usable strings which ElDoc picks according + ;; to its space contraints. (describe-char-eldoc--format ch (unless (eq eldoc-echo-area-use-multiline-p t) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 12bde8faf39..194ceee176f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -557,7 +557,10 @@ (let ((args (mapcar #'byte-optimize-form (cdr form)))) (if (and (get fn 'pure) (byte-optimize-all-constp args)) - (list 'quote (apply fn (mapcar #'eval args))) + (let ((arg-values (mapcar #'eval args))) + (condition-case nil + (list 'quote (apply fn arg-values)) + (error (cons fn args)))) (cons fn args))))))) (defun byte-optimize-all-constp (list) @@ -672,36 +675,18 @@ (apply (car form) constants)) form))) -;; Portable Emacs integers fall in this range. -(defconst byte-opt--portable-max #x1fffffff) -(defconst byte-opt--portable-min (- -1 byte-opt--portable-max)) - -;; True if N is a number that works the same on all Emacs platforms. -;; Portable Emacs fixnums are exactly representable as floats on all -;; Emacs platforms, and (except for -0.0) any floating-point number -;; that equals one of these integers must be the same on all -;; platforms. Although other floating-point numbers such as 0.5 are -;; also portable, it can be tricky to characterize them portably so -;; they are not optimized. -(defun byte-opt--portable-numberp (n) - (and (numberp n) - (<= byte-opt--portable-min n byte-opt--portable-max) - (= n (floor n)) - (not (and (floatp n) (zerop n) - (condition-case () (< (/ n) 0) (error)))))) - -;; Use OP to reduce any leading prefix of portable numbers in the list -;; (cons ACCUM ARGS) down to a single portable number, and return the +;; Use OP to reduce any leading prefix of constant numbers in the list +;; (cons ACCUM ARGS) down to a single number, and return the ;; resulting list A of arguments. The idea is that applying OP to A ;; is equivalent to (but likely more efficient than) applying OP to ;; (cons ACCUM ARGS), on any Emacs platform. Do not make any special ;; provision for (- X) or (/ X); for example, it is the caller’s ;; responsibility that (- 1 0) should not be "optimized" to (- 1). (defun byte-opt--arith-reduce (op accum args) - (when (byte-opt--portable-numberp accum) + (when (numberp accum) (let (accum1) - (while (and (byte-opt--portable-numberp (car args)) - (byte-opt--portable-numberp + (while (and (numberp (car args)) + (numberp (setq accum1 (condition-case () (funcall op accum (car args)) (error)))) @@ -746,12 +731,11 @@ ;; (- x -1) --> (1+ x) ((equal (cdr args) '(-1)) (list '1+ (car args))) - ;; (- n) -> -n, where n and -n are portable numbers. + ;; (- n) -> -n, where n and -n are constant numbers. ;; This must be done separately since byte-opt--arith-reduce ;; is not applied to (- n). ((and (null (cdr args)) - (byte-opt--portable-numberp (car args)) - (byte-opt--portable-numberp (- (car args)))) + (numberp (car args))) (- (car args))) ;; not further optimized ((equal args (cdr form)) form) @@ -761,8 +745,7 @@ (let ((args (cdr form))) (when (null (cdr args)) (let ((n (car args))) - (when (and (byte-opt--portable-numberp n) - (byte-opt--portable-numberp (1+ n))) + (when (numberp n) (setq form (1+ n)))))) form) @@ -770,8 +753,7 @@ (let ((args (cdr form))) (when (null (cdr args)) (let ((n (car args))) - (when (and (byte-opt--portable-numberp n) - (byte-opt--portable-numberp (1- n))) + (when (numberp n) (setq form (1- n)))))) form) @@ -813,7 +795,7 @@ (t ;; This can enable some lapcode optimizations. (list (car form) (nth 2 form) (nth 1 form))))) -(defun byte-optimize-predicate (form) +(defun byte-optimize-constant-args (form) (let ((ok t) (rest (cdr form))) (while (and rest ok) @@ -828,9 +810,6 @@ (defun byte-optimize-identity (form) (if (and (cdr form) (null (cdr (cdr form)))) (nth 1 form) - (byte-compile-warn "identity called with %d arg%s, but requires 1" - (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s")) form)) (defun byte-optimize--constant-symbol-p (expr) @@ -863,21 +842,27 @@ ;; Arity errors reported elsewhere. form)) +(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)) + (defun byte-optimize-memq (form) ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar)) - (if (/= (length (cdr form)) 2) - (byte-compile-warn "memq called with %d arg%s, but requires 2" - (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s")) - (let ((list (nth 2 form))) - (when (and (eq (car-safe list) 'quote) + (if (= (length (cdr form)) 2) + (let ((list (nth 2 form))) + (if (and (eq (car-safe list) 'quote) (listp (setq list (cadr list))) (= (length list) 1)) - (setq form (byte-optimize-and - `(and ,(byte-optimize-predicate - `(eq ,(nth 1 form) ',(nth 0 list))) - ',list))))) - (byte-optimize-predicate form))) + `(and (eq ,(nth 1 form) ',(nth 0 list)) + ',list) + form)) + ;; Arity errors reported elsewhere. + form)) (defun byte-optimize-concat (form) "Merge adjacent constant arguments to `concat'." @@ -910,6 +895,8 @@ (put 'memq 'byte-optimizer 'byte-optimize-memq) (put 'memql 'byte-optimizer 'byte-optimize-member) (put 'member 'byte-optimizer 'byte-optimize-member) +(put 'assoc 'byte-optimizer 'byte-optimize-assoc) +(put 'rassoc 'byte-optimizer 'byte-optimize-assoc) (put '+ 'byte-optimizer 'byte-optimize-plus) (put '* 'byte-optimizer 'byte-optimize-multiply) @@ -925,31 +912,8 @@ (put 'string= 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate) -(put '< 'byte-optimizer 'byte-optimize-predicate) -(put '> 'byte-optimizer 'byte-optimize-predicate) -(put '<= 'byte-optimizer 'byte-optimize-predicate) -(put '>= 'byte-optimizer 'byte-optimize-predicate) (put '1+ 'byte-optimizer 'byte-optimize-1+) (put '1- 'byte-optimizer 'byte-optimize-1-) -(put 'not 'byte-optimizer 'byte-optimize-predicate) -(put 'null 'byte-optimizer 'byte-optimize-predicate) -(put 'consp 'byte-optimizer 'byte-optimize-predicate) -(put 'listp 'byte-optimizer 'byte-optimize-predicate) -(put 'symbolp 'byte-optimizer 'byte-optimize-predicate) -(put 'stringp 'byte-optimizer 'byte-optimize-predicate) -(put 'string< 'byte-optimizer 'byte-optimize-predicate) -(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate) -(put 'proper-list-p 'byte-optimizer 'byte-optimize-predicate) - -(put 'logand 'byte-optimizer 'byte-optimize-predicate) -(put 'logior 'byte-optimizer 'byte-optimize-predicate) -(put 'logxor 'byte-optimizer 'byte-optimize-predicate) -(put 'lognot 'byte-optimizer 'byte-optimize-predicate) - -(put 'car 'byte-optimizer 'byte-optimize-predicate) -(put 'cdr 'byte-optimizer 'byte-optimize-predicate) -(put 'car-safe 'byte-optimizer 'byte-optimize-predicate) -(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate) (put 'concat 'byte-optimizer 'byte-optimize-concat) @@ -980,7 +944,7 @@ nil)) ((null (cdr (cdr form))) (nth 1 form)) - ((byte-optimize-predicate form)))) + ((byte-optimize-constant-args form)))) (defun byte-optimize-or (form) ;; Throw away nil's, and simplify if less than 2 args. @@ -993,7 +957,7 @@ (setq form (copy-sequence form) rest (setcdr (memq (car rest) form) nil)))) (if (cdr (cdr form)) - (byte-optimize-predicate form) + (byte-optimize-constant-args form) (nth 1 form)))) (defun byte-optimize-cond (form) @@ -1140,7 +1104,7 @@ (list 'car (if (zerop (nth 1 form)) (nth 2 form) (list 'cdr (nth 2 form)))) - (byte-optimize-predicate form)) + form) form)) (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr) @@ -1152,7 +1116,7 @@ (while (>= (setq count (1- count)) 0) (setq form (list 'cdr form))) form) - (byte-optimize-predicate form)) + form) form)) ;; Fixme: delete-char -> delete-region (byte-coded) @@ -1295,9 +1259,9 @@ ;; Pure functions are side-effect free functions whose values depend ;; only on their arguments, not on the platform. For these functions, ;; calls with constant arguments can be evaluated at compile time. -;; This may shift runtime errors to compile time. For example, logand -;; is pure since its results are machine-independent, whereas ash is -;; not pure because (ash 1 29)'s value depends on machine word size. +;; For example, ash is pure since its results are machine-independent, +;; whereas lsh is not pure because (lsh -1 -1)'s value depends on the +;; fixnum range. ;; ;; When deciding whether a function is pure, do not worry about ;; mutable strings or markers, as they are so unlikely in real code @@ -1307,9 +1271,41 @@ ;; values if a marker is moved. (let ((pure-fns - '(% concat logand logcount logior lognot logxor - regexp-opt regexp-quote - string-to-char string-to-syntax symbol-name))) + '(concat regexp-opt regexp-quote + string-to-char string-to-syntax symbol-name + eq eql + = /= < <= => > min max + + - * / % mod abs ash 1+ 1- sqrt + logand logior lognot logxor logcount + copysign isnan ldexp float logb + floor ceiling round truncate + ffloor fceiling fround ftruncate + string= string-equal string< string-lessp + consp atom listp nlistp propert-list-p + sequencep arrayp vectorp stringp bool-vector-p hash-table-p + null not + numberp integerp floatp natnump characterp + integer-or-marker-p number-or-marker-p char-or-string-p + symbolp keywordp + type-of + identity ignore + + ;; The following functions are pure up to mutation of their + ;; arguments. This is pure enough for the purposes of + ;; constant folding, but not necessarily for all kinds of + ;; code motion. + car cdr car-safe cdr-safe nth nthcdr last + equal + length safe-length + memq memql member + ;; `assoc' and `assoc-default' are excluded since they are + ;; impure if the test function is (consider `string-match'). + assq rassq rassoc + plist-get lax-plist-get plist-member + aref elt + bool-vector-subsetp + bool-vector-count-population bool-vector-count-consecutive + ))) (while pure-fns (put (car pure-fns) 'pure t) (setq pure-fns (cdr pure-fns))) @@ -2194,7 +2190,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (or noninteractive (message "compiling %s...done" x))) '(byte-optimize-form byte-optimize-body - byte-optimize-predicate + byte-optimize-constant-args byte-optimize-binary-predicate ;; Inserted some more than necessary, to speed it up. byte-optimize-form-code-walker diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index a3e72c4b00d..6c1426ce5cb 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3138,23 +3138,29 @@ Of course, we really can't know that for sure, so it's just a heuristic." (cdr (assq sym byte-compile-macro-environment)))))) (pcase-dolist (`(,type . ,pred) - '((null . null) + ;; Mostly kept in alphabetical order. + '((array . arrayp) (atom . atom) - (real . numberp) - (fixnum . integerp) (base-char . characterp) + (boolean . booleanp) + (bool-vector . bool-vector-p) + (buffer . bufferp) (character . natnump) - ;; "Obvious" mappings. - (string . stringp) - (list . listp) + (char-table . char-table-p) (cons . consp) - (symbol . symbolp) + (fixnum . integerp) + (float . floatp) (function . functionp) (integer . integerp) - (float . floatp) - (boolean . booleanp) + (keyword . keywordp) + (list . listp) + (number . numberp) + (null . null) + (real . numberp) + (sequence . sequencep) + (string . stringp) + (symbol . symbolp) (vector . vectorp) - (array . arrayp) ;; FIXME: Do we really want to consider this a type? (integer-or-marker . integer-or-marker-p) )) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index ef5dbf8103f..6ed5bff9f44 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.0.0 +;; Version: 1.5.0 ;; Package-Requires: ((emacs "26.3")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -47,6 +47,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup eldoc nil "Show function arglist or variable docstring in echo area." :group 'lisp @@ -77,38 +79,50 @@ Actually, any name of a function which takes a string as an argument and returns another string is acceptable. Note that this variable has no effect, unless -`eldoc-documentation-function' handles it explicitly." +`eldoc-documentation-strategy' handles it explicitly." :type '(radio (function-item upcase) (function-item downcase) function)) (make-obsolete-variable 'eldoc-argument-case nil "25.1") (defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit - "Allow long ElDoc messages to resize echo area display. -If value is t, never attempt to truncate messages; complete symbol name -and function arglist or 1-line variable documentation will be displayed -even if echo area must be resized to fit. - -If value is any non-nil value other than t, symbol name may be truncated -if it will enable the function arglist or documentation string to fit on a -single line without resizing window. Otherwise, behavior is just like -former case. - -If value is nil, messages are always truncated to fit in a single line of -display in the echo area. Function or variable symbol name may be -truncated to make more of the arglist or documentation string visible. - -Note that this variable has no effect, unless -`eldoc-documentation-function' handles it explicitly." - :type '(radio (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "Yes, but truncate symbol names if it will\ - enable argument list to fit on one line" truncate-sym-name-if-fit))) + "Allow long ElDoc doc strings to resize echo area display. +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. + +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 nil, a doc string is always truncated to fit in a +single line of display in the echo area." + :type '(radio (const :tag "Always" t) + (float :tag "Fraction of frame height" 0.25) + (integer :tag "Number of lines" 5) + (const :tag "Never" nil) + (const :tag "Yes, but ask major-mode to truncate + symbol names if it will\ enable argument list to fit on one + line" truncate-sym-name-if-fit))) + +(defcustom eldoc-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." + :type 'boolean) (defface eldoc-highlight-function-argument '((t (:inherit bold))) "Face used for the argument at point in a function's argument list. -Note that this face has no effect unless the `eldoc-documentation-function' +Note that this face has no effect unless the `eldoc-documentation-strategy' handles it explicitly.") ;;; No user options below here. @@ -150,7 +164,7 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.") This is used to determine if `eldoc-idle-delay' is changed by the user.") (defvar eldoc-message-function #'eldoc-minibuffer-message - "The function used by `eldoc-message' to display messages. + "The function used by `eldoc--message' to display messages. It should receive the same arguments as `message'.") (defun eldoc-edit-message-commands () @@ -203,7 +217,7 @@ expression point is on." :lighter eldoc-minor-mode-string :init-value t ;; For `read--expression', the usual global mode mechanism of ;; `change-major-mode-hook' runs in the minibuffer before - ;; `eldoc-documentation-function' is set, so `turn-on-eldoc-mode' + ;; `eldoc-documentation-strategy' is set, so `turn-on-eldoc-mode' ;; does nothing. Configure and enable eldoc from ;; `eval-expression-minibuffer-setup-hook' instead. (if global-eldoc-mode @@ -216,13 +230,16 @@ expression point is on." :lighter eldoc-minor-mode-string ;; Setup `eldoc', similar to `emacs-lisp-mode'. FIXME: Call ;; `emacs-lisp-mode' itself? (add-hook 'eldoc-documentation-functions - #'elisp-eldoc-documentation-function nil t) + #'elisp-eldoc-var-docstring nil t) + (add-hook 'eldoc-documentation-functions + #'elisp-eldoc-funcall nil t) + (setq eldoc-documentation-strategy 'eldoc-documentation-default) (eldoc-mode +1)) ;;;###autoload (defun turn-on-eldoc-mode () "Turn on `eldoc-mode' if the buffer has ElDoc support enabled. -See `eldoc-documentation-function' for more detail." +See `eldoc-documentation-strategy' for more detail." (when (eldoc--supported-p) (eldoc-mode 1))) @@ -241,7 +258,9 @@ reflect the change." (when (or eldoc-mode (and global-eldoc-mode (eldoc--supported-p))) - (eldoc-print-current-symbol-info)))))) + ;; Don't ignore, but also don't full-on signal errors + (with-demoted-errors "eldoc error: %s" + (eldoc-print-current-symbol-info)) ))))) ;; If user has changed the idle delay, update the timer. (cond ((not (= eldoc-idle-delay eldoc-current-idle-delay)) @@ -279,7 +298,10 @@ Otherwise work like `message'." (force-mode-line-update))) (apply #'message format-string args))) -(defun eldoc-message (&optional string) +(make-obsolete + 'eldoc-message "use `eldoc-documentation-functions' instead." "eldoc-1.1.0") +(defun eldoc-message (&optional string) (eldoc--message string)) +(defun eldoc--message (&optional string) "Display STRING as an ElDoc message if it's non-nil. Also store it in `eldoc-last-message' and return that value." @@ -313,8 +335,8 @@ Also store it in `eldoc-last-message' and return that value." (not (minibufferp)) ;We don't use the echo area when in minibuffer. (if (and (eldoc-display-message-no-interference-p) (eldoc--message-command-p this-command)) - (eldoc-message eldoc-last-message) - ;; No need to call eldoc-message since the echo area will be cleared + (eldoc--message eldoc-last-message) + ;; No need to call eldoc--message since the echo area will be cleared ;; for us, but do note that the last-message will be gone. (setq eldoc-last-message nil)))) @@ -338,12 +360,39 @@ Also store it in `eldoc-last-message' and return that value." (defvar eldoc-documentation-functions nil - "Hook for functions to call to return doc string. -Each function should accept no arguments and return a one-line -string for displaying doc about a function etc. appropriate to -the context around point. It should return nil if there's no doc -appropriate for the context. Typically doc is returned if point -is on a function-like name or in its arg list. + "Hook of functions that produce doc strings. + +A doc string is typically relevant if point is on a function-like +name, inside its arg list, or on any object with some associated +information. + +Each hook function is called with at least one argument CALLBACK, +a function, and decides whether to display a doc short string +about the context around point. + +- If that decision can be taken quickly, the hook function may + call CALLBACK immediately following the protocol described + below. Alternatively it may ignore CALLBACK entirely and + return either the doc string, or nil if there's no doc + appropriate for the context. + +- If the computation of said doc string (or the decision whether + there is one at all) is expensive or can't be performed + directly, the hook function should return a non-nil, non-string + value and arrange for CALLBACK to be called at a later time, + using asynchronous processes or other asynchronous mechanisms. + +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 contraints; + +* `:face', VALUE is a symbol designating a face to use when + displaying `:thing''s value. Major modes should modify this hook locally, for example: (add-hook \\='eldoc-documentation-functions #\\='foo-mode-eldoc nil t) @@ -351,110 +400,360 @@ 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--doc-buffer nil "Buffer holding latest eldoc-produced docs.") +(defun eldoc-doc-buffer (&optional interactive) + "Get latest *eldoc* help buffer. Interactively, display it." + (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) + (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) + max-mini-window-height + eldoc-echo-area-use-multiline-p)) + (available (cl-typecase val + (float (truncate (* (frame-height) val))) + (integer val) + (t 1))) + (things-reported-on) + single-doc single-doc-sym) + ;; Then, compose the contents of the `*eldoc*' buffer. + (with-current-buffer (eldoc-doc-buffer) + (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. + (and + (eq 'truncate-sym-name-if-fit eldoc-echo-area-use-multiline-p) + (null (cdr docs)) + (setq single-doc (caar docs)) + (setq single-doc-sym + (format "%s" (plist-get (cdar docs) :thing))) + (< (length single-doc) width) + (not (string-match "\n" single-doc)) + (> (+ (length single-doc) (length single-doc-sym) 2) width)) + single-doc) + ((> available 1) + (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 + (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)))))) + (when echo-area-message + (eldoc--message echo-area-message)))))) + (defun eldoc-documentation-default () "Show first doc string for item at point. -Default value for `eldoc-documentation-function'." - (let ((res (run-hook-with-args-until-success 'eldoc-documentation-functions))) - (when res - (if eldoc-echo-area-use-multiline-p res - (truncate-string-to-width - res (1- (window-width (minibuffer-window)))))))) +Default value for `eldoc-documentation-strategy'." + (run-hook-with-args-until-success 'eldoc-documentation-functions + (eldoc--make-callback :patient))) + +(defun eldoc--documentation-compose-1 (eagerlyp) + "Helper function for composing multiple doc strings. +If EAGERLYP is non-nil show documentation as soon as possible, +else wait for all doc strings." + (run-hook-wrapped 'eldoc-documentation-functions + (lambda (f) + (let* ((callback (eldoc--make-callback + (if eagerlyp :eager :patient))) + (str (funcall f callback))) + (if (or (null str) (stringp str)) (funcall callback str)) + nil))) + t) (defun eldoc-documentation-compose () - "Show multiple doc string results at once. -Meant as a value for `eldoc-documentation-function'." - (let (res) - (run-hook-wrapped - 'eldoc-documentation-functions - (lambda (f) - (let ((str (funcall f))) - (when str (push str res)) - nil))) - (when res - (setq res (mapconcat #'identity (nreverse res) ", ")) - (if eldoc-echo-area-use-multiline-p res - (truncate-string-to-width - res (1- (window-width (minibuffer-window)))))))) - -(defcustom eldoc-documentation-function #'eldoc-documentation-default - "Function to call to return doc string. -The function of no args should return a one-line string for displaying -doc about a function etc. appropriate to the context around point. -It should return nil if there's no doc appropriate for the context. -Typically doc is returned if point is on a function-like name or in its -arg list. - -The result is used as is, so the function must explicitly handle -the variables `eldoc-argument-case' and `eldoc-echo-area-use-multiline-p', -and the face `eldoc-highlight-function-argument', if they are to have any -effect." + "Show multiple doc strings at once after waiting for all. +Meant as a value for `eldoc-documentation-strategy'." + (eldoc--documentation-compose-1 nil)) + +(defun eldoc-documentation-compose-eagerly () + "Show multiple doc strings at once as soon as possible. +Meant as a value for `eldoc-documentation-strategy'." + (eldoc--documentation-compose-1 t)) + +(defun eldoc-documentation-enthusiast () + "Show most important doc string produced so far. +Meant as a value for `eldoc-documentation-strategy'." + (run-hook-wrapped 'eldoc-documentation-functions + (lambda (f) + (let* ((callback (eldoc--make-callback :enthusiast)) + (str (funcall f callback))) + (if (stringp str) (funcall callback str)) + nil)))) + +;; JT@2020-07-10: ElDoc is pre-loaded, so in Emacs < 28 we can't +;; make the "old" `eldoc-documentation-function' point to the new +;; `eldoc-documentation-strategy', so we do the reverse. This allows +;; for ElDoc to be loaded in those older Emacs versions and work with +;; whomever (major-modes, extensions, user) sets one or the other +;; variable. +(defmacro eldoc--documentation-strategy-defcustom + (main secondary value docstring &rest more) + "Defcustom helper macro for sorting `eldoc-documentation-strategy'." + (declare (indent 2)) + `(if (< emacs-major-version 28) + (progn + (defcustom ,secondary ,value ,docstring ,@more) + (define-obsolete-variable-alias ',main ',secondary "eldoc-1.1.0")) + (progn + (defcustom ,main ,value ,docstring ,@more) + (defvaralias ',secondary ',main ,docstring)))) + +(eldoc--documentation-strategy-defcustom eldoc-documentation-strategy + eldoc-documentation-function + #'eldoc-documentation-default + "How to collect and organize results of `eldoc-documentation-functions'. + +This variable controls how `eldoc-documentation-functions', which +specifies the sources of documentation, is queried and how its +results are organized before being displayed to the user. The +following values are allowed: + +- `eldoc-documentation-default': calls functions in the special + hook in order until one is found that produces a doc string + value. Display only that value; + +- `eldoc-documentation-compose': calls all functions in the + special hook and displays all of the resulting doc strings + together. Wait for all strings to be ready, and preserve their + relative as specified by the order of functions in the hook; + +- `eldoc-documentation-compose-eagerly': calls all functions in + the special hook and display as many of the resulting doc + strings as possible, as soon as possibl. Preserving the + relative order of doc strings; + +- `eldoc-documentation-enthusiast': calls all functions in the + special hook and displays only the most important resulting + docstring one at any given time. A function appearing first in + the special hook is considered more important. + +This variable can also be set to a function of no args that +returns something other than a string or nil and allows for some +or all of the special hook `eldoc-documentation-functions' to be +run. In that case, the strategy function should follow that +other variable's protocol closely and endeavor to display the +resulting doc strings itself. + +For backward compatibility to the \"old\" protocol, this variable +can also be set to a function that returns nil or a doc string, +depending whether or not there is documentation to display at +all." :link '(info-link "(emacs) Lisp Doc") :type '(radio (function-item eldoc-documentation-default) (function-item eldoc-documentation-compose) + (function-item eldoc-documentation-compose-eagerly) + (function-item eldoc-documentation-enthusiast) (function :tag "Other function")) :version "28.1") (defun eldoc--supported-p () "Non-nil if an ElDoc function is set for this buffer." - (and (not (memq eldoc-documentation-function '(nil ignore))) + (and (not (memq eldoc-documentation-strategy '(nil ignore))) (or eldoc-documentation-functions ;; The old API had major modes set `eldoc-documentation-function' ;; to provide eldoc support. It's impossible now to determine - ;; reliably whether the `eldoc-documentation-function' provides + ;; reliably whether the `eldoc-documentation-strategy' provides ;; eldoc support (as in the old API) or whether it just provides ;; a way to combine the results of the ;; `eldoc-documentation-functions' (as in the new API). ;; But at least if it's set buffer-locally it's a good hint that ;; there's some eldoc support in the current buffer. - (local-variable-p 'eldoc-documentation-function)))) - -(defun eldoc-print-current-symbol-info () - "Print the text produced by `eldoc-documentation-function'." - ;; This is run from post-command-hook or some idle timer thing, - ;; so we need to be careful that errors aren't ignored. - (with-demoted-errors "eldoc error: %s" - (if (not (eldoc-display-message-p)) - ;; Erase the last message if we won't display a new one. - (when eldoc-last-message - (eldoc-message nil)) - (let ((non-essential t)) - ;; 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-message (funcall eldoc-documentation-function))))))) - -;; If the entire line cannot fit in the echo area, the symbol name may be -;; truncated or eliminated entirely from the output to make room for the -;; description. -(defun eldoc-docstring-format-sym-doc (prefix doc &optional face) - "Combine PREFIX and DOC, and shorten the result to fit in the echo area. - -When PREFIX is a symbol, propertize its symbol name with FACE -before combining it with DOC. If FACE is not provided, just -apply the nil face. - -See also: `eldoc-echo-area-use-multiline-p'." - (when (symbolp prefix) - (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": "))) - (let* ((ea-multi eldoc-echo-area-use-multiline-p) - ;; Subtract 1 from window width since emacs will not write - ;; any chars to the last column, or in later versions, will - ;; cause a wraparound and resize of the echo area. - (ea-width (1- (window-width (minibuffer-window)))) - (strip (- (+ (length prefix) (length doc)) ea-width))) - (cond ((or (<= strip 0) - (eq ea-multi t) - (and ea-multi (> (length doc) ea-width))) - (concat prefix doc)) - ((> (length doc) ea-width) - (substring (format "%s" doc) 0 ea-width)) - ((>= strip (string-match-p ":? *\\'" prefix)) - doc) - (t - ;; Show the end of the partial symbol name, rather - ;; than the beginning, since the former is more likely - ;; to be unique given package namespace conventions. - (concat (substring prefix strip) doc))))) + (local-variable-p 'eldoc-documentation-strategy)))) + +(defvar eldoc--enthusiasm-curbing-timer nil + "Timer used by the `eldoc-documentation-enthusiast' strategy. +When a doc string is encountered, it must endure a certain amount +of time unchallenged until it is displayed to the user. This +prevents blinking if a lower priority docstring comes in shortly +before a higher priority one.") + +(defalias 'eldoc #'eldoc-print-current-symbol-info) + +;; This variable should be unbound, but that confuses +;; `describe-symbol' for some reason. +(defvar eldoc--make-callback nil "Helper for function `eldoc--make-callback'.") + +;; JT@2020-07-08: the below docstring for the internal function +;; `eldoc--invoke-strategy' could be moved to +;; `eldoc-documentation-strategy' or thereabouts if/when we decide to +;; extend or publish the `make-callback' protocol. +(defun eldoc--make-callback (method) + "Make callback suitable for `eldoc-documentation-functions'. +The return value is a function FN whose lambda list is (STRING +&rest PLIST) and can be called by those functions. Its +responsibility is always to register the docstring STRING along +with options specified in PLIST as the documentation to display +for each particular situation. + +METHOD specifies how the callback behaves relative to other +competing elements in `eldoc-documentation-functions'. It can +have the following values: + +- `:enthusiast' says to display STRING as soon as possible if + there's no higher priority doc string; + +- `:patient' says to display STRING along with all other + competing strings but only when all of all + `eldoc-documentation-functions' have been collected; + +- `:eager' says to display STRING along with all other competing + strings so far, as soon as possible." + (funcall eldoc--make-callback method)) + +(defun eldoc--invoke-strategy () + "Invoke `eldoc-documentation-strategy' function. + +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." + (let* (;; How many callbacks have been created by the strategy + ;; fucntion and passed to elements of + ;; `eldoc-documentation-functions'. + (howmany 0) + ;; How many calls to callbacks we're still waiting on. Used + ;; by `:patient'. + (want 0) + ;; The doc strings and corresponding options registered so + ;; far. + (docs-registered '())) + (cl-labels + ((register-doc + (pos string plist) + (when (and string (> (length string) 0)) + (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)))))))) + (make-callback + (method) + (let ((pos (prog1 howmany (cl-incf howmany)))) + (cl-ecase method + (:enthusiast + (lambda (string &rest plist) + (when (and string (cl-loop for (p) in docs-registered + never (< p pos))) + (setq docs-registered '()) + (register-doc pos string plist) + (when (and (timerp eldoc--enthusiasm-curbing-timer) + (memq eldoc--enthusiasm-curbing-timer + timer-list)) + (cancel-timer eldoc--enthusiasm-curbing-timer)) + (setq eldoc--enthusiasm-curbing-timer + (run-at-time (unless (zerop pos) 0.3) + nil #'display-doc))) + t)) + (:patient + (cl-incf want) + (lambda (string &rest plist) + (register-doc pos string plist) + (when (zerop (cl-decf want)) (display-doc)) + t)) + (:eager + (lambda (string &rest plist) + (register-doc pos string plist) + (display-doc) + t)))))) + (let* ((eldoc--make-callback #'make-callback) + (res (funcall eldoc-documentation-strategy))) + ;; Observe the old and the new protocol: + (cond (;; Old protocol: got string, output immediately; + (stringp res) (register-doc 0 res nil) (display-doc)) + (;; Old protocol: got nil, clear the echo area; + (null res) (eldoc--message nil)) + (;; New protocol: trust callback will be called; + t)))))) + +(defun eldoc-print-current-symbol-info (&optional interactive) + "Document thing at point." + (interactive '(t)) + (cond (interactive + (eldoc--invoke-strategy)) + (t + (if (not (eldoc-display-message-p)) + ;; Erase the last message if we won't display a new one. + (when eldoc-last-message + (eldoc--message nil)) + (let ((non-essential t)) + ;; 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))))))) ;; 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 diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el index b6e98f59a7a..61bd98d3cfe 100644 --- a/lisp/emacs-lisp/text-property-search.el +++ b/lisp/emacs-lisp/text-property-search.el @@ -137,11 +137,19 @@ and if a matching region is found, moves point to its beginning." nil) ;; We're standing in the property we're looking for, so find the ;; end. - ((and (text-property--match-p - value (get-text-property (1- (point)) property) - predicate) - (not not-current)) - (text-property--find-end-backward (1- (point)) property value predicate)) + ((text-property--match-p + value (get-text-property (1- (point)) property) + predicate) + (let ((origin (point)) + (match (text-property--find-end-backward + (1- (point)) property value predicate))) + ;; When we want to ignore the current element, then repeat the + ;; search if we haven't moved out of it yet. + (if (and not-current + (equal (get-text-property (point) property) + (get-text-property origin property))) + (text-property-search-backward property value predicate) + match))) (t (let ((origin (point)) (ended nil) diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el index f601d426566..9269ea97070 100644 --- a/lisp/epa-dired.el +++ b/lisp/epa-dired.el @@ -29,48 +29,40 @@ (defun epa-dired-do-decrypt () "Decrypt marked files." (interactive) - (let ((file-list (dired-get-marked-files))) - (while file-list - (epa-decrypt-file (expand-file-name (car file-list))) - (setq file-list (cdr file-list))) - (revert-buffer))) + (dolist (file (dired-get-marked-files)) + (epa-decrypt-file (expand-file-name file))) + (revert-buffer)) ;;;###autoload (defun epa-dired-do-verify () "Verify marked files." (interactive) - (let ((file-list (dired-get-marked-files))) - (while file-list - (epa-verify-file (expand-file-name (car file-list))) - (setq file-list (cdr file-list))))) + (dolist (file (dired-get-marked-files)) + (epa-verify-file (expand-file-name file)))) ;;;###autoload (defun epa-dired-do-sign () "Sign marked files." (interactive) - (let ((file-list (dired-get-marked-files))) - (while file-list - (epa-sign-file - (expand-file-name (car file-list)) - (epa-select-keys (epg-make-context) "Select keys for signing. + (dolist (file (dired-get-marked-files)) + (epa-sign-file + (expand-file-name file) + (epa-select-keys (epg-make-context) "Select keys for signing. If no one is selected, default secret key is used. " - nil t) - (y-or-n-p "Make a detached signature? ")) - (setq file-list (cdr file-list))) - (revert-buffer))) + nil t) + (y-or-n-p "Make a detached signature? "))) + (revert-buffer)) ;;;###autoload (defun epa-dired-do-encrypt () "Encrypt marked files." (interactive) - (let ((file-list (dired-get-marked-files))) - (while file-list - (epa-encrypt-file - (expand-file-name (car file-list)) - (epa-select-keys (epg-make-context) "Select recipients for encryption. -If no one is selected, symmetric encryption will be performed. ")) - (setq file-list (cdr file-list))) - (revert-buffer))) + (dolist (file (dired-get-marked-files)) + (epa-encrypt-file + (expand-file-name file) + (epa-select-keys (epg-make-context) "Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. "))) + (revert-buffer)) (provide 'epa-dired) diff --git a/lisp/epa-file.el b/lisp/epa-file.el index dedf20b0d77..20043a9eae4 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -40,9 +40,9 @@ Note that this option has no effect if you use GnuPG 2.0." (defcustom epa-file-select-keys nil "Control whether or not to pop up the key selection dialog. -If t, always asks user to select recipients. +If t, always ask user to select recipients. If nil, query user only when `epa-file-encrypt-to' is not set. -If neither t nor nil, doesn't ask user. In this case, symmetric +If neither t nor nil, don't ask user. In this case, symmetric encryption is used." :type '(choice (const :tag "Ask always" t) (const :tag "Ask when recipients are not set" nil) @@ -51,16 +51,6 @@ encryption is used." (defvar epa-file-passphrase-alist nil) -(eval-and-compile - (if (fboundp 'encode-coding-string) - (defalias 'epa-file--encode-coding-string 'encode-coding-string) - (defalias 'epa-file--encode-coding-string 'identity))) - -(eval-and-compile - (if (fboundp 'decode-coding-string) - (defalias 'epa-file--decode-coding-string 'decode-coding-string) - (defalias 'epa-file--decode-coding-string 'identity))) - (defun epa-file-passphrase-callback-function (context key-id file) (if (and epa-file-cache-passphrase-for-symmetric-encryption (eq key-id 'SYM)) @@ -71,8 +61,8 @@ encryption is used." (or (copy-sequence (cdr entry)) (progn (unless entry - (setq entry (list file) - epa-file-passphrase-alist + (setq entry (list file)) + (setq epa-file-passphrase-alist (cons entry epa-file-passphrase-alist))) (setq passphrase (epa-passphrase-callback-function context @@ -236,11 +226,7 @@ encryption is used." (setq file (expand-file-name file)) (let* ((coding-system (or coding-system-for-write (if (fboundp 'select-safe-coding-system) - ;; This is needed since Emacs 22 has - ;; no-conversion setting for *.gpg in - ;; `auto-coding-alist'. - (let ((buffer-file-name - (file-name-sans-extension file))) + (let ((buffer-file-name file)) (select-safe-coding-system (point-min) (point-max))) buffer-file-coding-system))) @@ -266,7 +252,7 @@ encryption is used." (epg-encrypt-string context (if (stringp start) - (epa-file--encode-coding-string start coding-system) + (encode-coding-string start coding-system) (unless start (setq start (point-min) end (point-max))) @@ -280,8 +266,8 @@ encryption is used." ;; decrypted contents. (format-encode-buffer (with-current-buffer buffer buffer-file-format)) - (epa-file--encode-coding-string (buffer-string) - coding-system))) + (encode-coding-string (buffer-string) + coding-system))) (if (or (eq epa-file-select-keys t) (and (null epa-file-select-keys) (not (local-variable-p 'epa-file-encrypt-to diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index d424e7a9faf..a86f23eb688 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -35,10 +35,10 @@ (defcustom epa-file-name-regexp (purecopy "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'") "Regexp which matches filenames to be encrypted with GnuPG. -If you set this outside Custom while epa-file is already enabled, you -have to call `epa-file-name-regexp-update' after setting it to -properly update file-name-handler-alist. Setting this through Custom -does that automatically." +If you set this outside Custom while epa-file is already enabled, +you have to call `epa-file-name-regexp-update' after setting it +to properly update `file-name-handler-alist'. Setting this +through Custom does that automatically." :type 'regexp :group 'epa-file :set 'epa-file--file-name-regexp-set) @@ -72,6 +72,9 @@ May either be a string or a list of strings.") (list epa-file-name-regexp nil 'epa-file)) (defun epa-file-name-regexp-update () + "Update `file-name-handler-alist' after configuring outside Custom. +After setting `epa-file-name-regexp-update' outside the Custom +interface, update `file-name-handler-alist'." (interactive) (unless (equal (car epa-file-handler) epa-file-name-regexp) (setcar epa-file-handler epa-file-name-regexp))) diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 00f560af0b7..63475256ca8 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -85,7 +85,10 @@ The buffer is expected to contain a mail message." ;;;###autoload (defun epa-mail-sign (start end signers mode) "Sign the current buffer. -The buffer is expected to contain a mail message." +The buffer is expected to contain a mail message, and signing is +performed with your default key. +With prefix argument, asks you to select interactively the key to +use from your key ring." (declare (interactive-only t)) (interactive (save-excursion diff --git a/lisp/epa.el b/lisp/epa.el index 8ec42187358..3c7dd8309a8 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -25,7 +25,9 @@ (require 'epg) (require 'font-lock) (require 'widget) -(eval-when-compile (require 'wid-edit)) +(eval-when-compile + (require 'subr-x) + (require 'wid-edit)) (require 'derived) (defgroup epa nil @@ -56,11 +58,6 @@ If neither t nor nil, ask user for confirmation." :type 'integer :group 'epa) -(defgroup epa-faces nil - "Faces for epa-mode." - :version "23.1" - :group 'epa) - (defcustom epa-mail-aliases nil "Alist of aliases of email addresses that stand for encryption keys. Each element is a list of email addresses (ALIAS EXPANSIONS...). @@ -76,6 +73,11 @@ The command `epa-mail-encrypt' uses this." :group 'epa :version "24.4") +(defgroup epa-faces nil + "Faces for epa-mode." + :version "23.1" + :group 'epa) + (defface epa-validity-high '((default :weight bold) (((class color) (background dark)) :foreground "PaleTurquoise")) @@ -117,13 +119,15 @@ The command `epa-mail-encrypt' uses this." '((default :weight bold) (((class color) (background dark)) :foreground "PaleTurquoise")) "Face for the name of the attribute field." - :group 'epa) + :version "28.1" + :group 'epa-faces) (defface epa-field-body '((default :slant italic) (((class color) (background dark)) :foreground "turquoise")) "Face for the body of the attribute field." - :group 'epa) + :version "28.1" + :group 'epa-faces) (defcustom epa-validity-face-alist '((unknown . epa-validity-disabled) @@ -138,8 +142,9 @@ The command `epa-mail-encrypt' uses this." (full . epa-validity-high) (ultimate . epa-validity-high)) "An alist mapping validity values to faces." + :version "28.1" :type '(repeat (cons symbol face)) - :group 'epa) + :group 'epa-faces) (defvar epa-font-lock-keywords '(("^\\*" @@ -185,6 +190,8 @@ You should bind this variable with `let', but do not set it globally.") (defvar epa-key-list-mode-map (let ((keymap (make-sparse-keymap)) (menu-map (make-sparse-keymap))) + (set-keymap-parent keymap widget-keymap) + (define-key keymap "\C-m" 'epa-show-key) (define-key keymap "m" 'epa-mark-key) (define-key keymap "u" 'epa-unmark-key) (define-key keymap "d" 'epa-decrypt-file) @@ -332,8 +339,7 @@ If ARG is non-nil, mark the key." (epa-mark-key (not arg))) (defun epa-exit-buffer () - "Exit the current buffer. -`epa-exit-buffer-function' is called if it is set." + "Exit the current buffer using `epa-exit-buffer-function'." (interactive) (funcall epa-exit-buffer-function)) @@ -397,8 +403,7 @@ DOC is documentation text to insert at the start." (goto-char point)) (epa--insert-keys (epg-list-keys context name secret)) - (widget-setup) - (set-keymap-parent (current-local-map) widget-keymap)) + (widget-setup)) (make-local-variable 'epa-list-keys-arguments) (setq epa-list-keys-arguments (list name secret)) (goto-char (point-min)) @@ -500,6 +505,14 @@ If SECRET is non-nil, list secret keys instead of public keys." (let ((keys (epg-list-keys context names secret))) (epa--select-keys prompt keys))) +(defun epa-show-key () + "Show a key on the current line." + (interactive) + (if-let ((key (get-text-property (point) 'epa-key))) + (save-selected-window + (epa--show-key key)) + (error "No key on this line"))) + (defun epa--show-key (key) (let* ((primary-sub-key (car (epg-key-sub-key-list key))) (entry (assoc (epg-sub-key-id primary-sub-key) diff --git a/lisp/epg-config.el b/lisp/epg-config.el index daa9a5abd17..1c429246529 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -202,13 +202,13 @@ version requirement is met." (cond ((eq type 'group) (if (string-match "\\`\\([^:]+\\):" args) - (setq groups - (cons (cons (downcase (match-string 1 args)) - (delete "" (split-string - (substring args - (match-end 0)) - ";"))) - groups)) + (setq groups + (cons (cons (downcase (match-string 1 args)) + (delete "" (split-string + (substring args + (match-end 0)) + ";"))) + groups)) (if epg-debug (message "Invalid group configuration: %S" args)))) ((memq type '(pubkey cipher digest compress)) diff --git a/lisp/frame.el b/lisp/frame.el index 77080b76e4f..081d3010e9b 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1083,7 +1083,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (cons (display-buffer-pop-up-frame buffer (append '((inhibit-same-window . t)) alist)) - 'frame))) + 'frame)) + nil "[other-frame]") (message "Display next command buffer in a new frame...")) (defun iconify-or-deiconify-frame () diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 1ed5000eb36..88873f47bd5 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -603,11 +603,22 @@ manipulated as follows: (gnus)) ;;;###autoload +(defun gnus-child-unplugged (&optional arg) + "Read news as a child unplugged." + (interactive "P") + (setq gnus-plugged nil) + (gnus arg nil 'child)) + +;;;###autoload (defun gnus-slave-unplugged (&optional arg) - "Read news as a slave unplugged." + "Read news as a child unplugged." (interactive "P") (setq gnus-plugged nil) - (gnus arg nil 'slave)) + (gnus arg nil 'child)) +(make-obsolete 'gnus-slave-unplugged 'gnus-child-unplugged "28.1") + + + ;;;###autoload (defun gnus-agentize () diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 614651afff9..cb20d7102bd 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2303,21 +2303,27 @@ long lines if and only if arg is positive." "\n") (put-text-property start (point) 'gnus-decoration 'header))))) -(defun article-fill-long-lines () - "Fill lines that are wider than the window width." - (interactive) +(defun article-fill-long-lines (&optional width) + "Fill lines that are wider than the window width or `fill-column'. +If WIDTH (interactively, the numeric prefix), use that as the +fill width." + (interactive "P") (save-excursion - (let ((inhibit-read-only t) - (width (window-width (get-buffer-window (current-buffer))))) + (let* ((inhibit-read-only t) + (window-width (window-width (get-buffer-window (current-buffer)))) + (width (if width + (prefix-numeric-value width) + (min fill-column window-width)))) (save-restriction (article-goto-body) (let ((adaptive-fill-mode nil)) ;Why? -sm (while (not (eobp)) (end-of-line) - (when (>= (current-column) (min fill-column width)) + (when (>= (current-column) width) (narrow-to-region (min (1+ (point)) (point-max)) (point-at-bol)) - (let ((goback (point-marker))) + (let ((goback (point-marker)) + (fill-column width)) (fill-paragraph nil) (goto-char (marker-position goback))) (widen)) @@ -4406,6 +4412,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is "e" gnus-article-read-summary-keys "\C-d" gnus-article-read-summary-keys + "\C-c\C-f" gnus-summary-mail-forward "\M-*" gnus-article-read-summary-keys "\M-#" gnus-article-read-summary-keys "\M-^" gnus-article-read-summary-keys @@ -6674,7 +6681,7 @@ not have a face in `gnus-article-boring-faces'." (interactive "P") (gnus-article-check-buffer) (let ((nosaves - '("q" "Q" "r" "\C-c\C-f" "m" "a" "f" "WDD" "WDW" + '("q" "Q" "r" "m" "a" "f" "WDD" "WDW" "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "^" "\M-^" "|")) (nosave-but-article @@ -7718,6 +7725,15 @@ positives are possible." 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1) ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) + ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)... + ("<URL: *\\([^\n<>]*\\)>" + 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) + ;; RFC 2396 (2.4.3., delims) ... + ("\"URL: *\\([^\n\"]*\\)\"" + 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) + ;; Raw URLs. + (gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0) ;; The following entries may lead to many false positives so don't enable ;; them by default (use a high button level). ("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]" @@ -7741,15 +7757,6 @@ positives are possible." ;; Unlike the other regexps we really have to require quoting ;; here to determine where it ends. 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) - ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)... - ("<URL: *\\([^\n<>]*\\)>" - 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) - ;; RFC 2396 (2.4.3., delims) ... - ("\"URL: *\\([^\n\"]*\\)\"" - 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) - ;; Raw URLs. - (gnus-button-url-regexp - 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0) ;; man pages ("\\b\\([a-z][a-z]+([1-9])\\)\\W" 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index da7db589ec3..b207c4f1e06 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1129,8 +1129,8 @@ The following commands are available: (gnus-update-group-mark-positions) (when gnus-use-undo (gnus-undo-mode 1)) - (when gnus-slave - (gnus-slave-mode))) + (when gnus-child + (gnus-child-mode))) (defun gnus-update-group-mark-positions () (save-excursion @@ -4024,9 +4024,9 @@ otherwise all levels below ARG will be scanned too." (gnus-run-hooks 'gnus-get-top-new-news-hook) (gnus-run-hooks 'gnus-get-new-news-hook) - ;; Read any slave files. - (unless gnus-slave - (gnus-master-read-slave-newsrc)) + ;; Read any child files. + (unless gnus-child + (gnus-parent-read-child-newsrc)) (gnus-get-unread-articles (gnus-group-default-level arg t) nil one-level) diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index 5edbaaf201b..a772281d4c3 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -653,7 +653,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" gnus-options-not-subscribe) ;; Eat all arguments. (setq command-line-args-left nil) - (gnus-slave) + (gnus-child) ;; Apply kills to specified newsgroups in command line arguments. (setq newsrc (cdr gnus-newsrc-alist)) (while (setq info (pop newsrc)) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index daaea3980b5..cdfbf16db5e 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1510,7 +1510,11 @@ If YANK is non-nil, include the original article." (gnus-inews-yank-articles (list (cdr gnus-article-current))))))) (defun gnus-bug (subject) - "Send a bug report to the Emacs maintainers." + "Send a bug report to the Emacs maintainers. + +Already submitted bugs can be found in the Emacs bug tracker: + + https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1" (interactive "sBug Subject: ") (report-emacs-bug subject) (save-excursion diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index f306889a7fc..1ac1d05e033 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -449,19 +449,21 @@ This is not required after changing `gnus-registry-cache-file'." to subject sender recipients))) (defun gnus-registry-spool-action (id group &optional subject sender recipients) - (let ((to (gnus-group-guess-full-name-from-command-method group)) - (recipients (or recipients - (gnus-registry-sort-addresses - (or (message-fetch-field "cc") "") - (or (message-fetch-field "to") "")))) - (subject (or subject (message-fetch-field "subject"))) - (sender (or sender (message-fetch-field "from")))) - (when (and (stringp id) (string-match "\r$" id)) - (setq id (substring id 0 -1))) - (gnus-message 7 "Gnus registry: article %s spooled to %s" - id - to) - (gnus-registry-handle-action id nil to subject sender recipients))) + (save-restriction + (message-narrow-to-headers-or-head) + (let ((to (gnus-group-guess-full-name-from-command-method group)) + (recipients (or recipients + (gnus-registry-sort-addresses + (or (message-fetch-field "cc") "") + (or (message-fetch-field "to") "")))) + (subject (or subject (message-fetch-field "subject"))) + (sender (or sender (message-fetch-field "from")))) + (when (and (stringp id) (string-match "\r$" id)) + (setq id (substring id 0 -1))) + (gnus-message 7 "Gnus registry: article %s spooled to %s" + id + to) + (gnus-registry-handle-action id nil to subject sender recipients)))) (defun gnus-registry-handle-action (id from to subject sender &optional recipients) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 873923e6c57..ba8b91be5c5 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -730,7 +730,7 @@ the first newsgroup." ;; Remove Gnus frames. (gnus-kill-gnus-frames)) -(defun gnus-no-server-1 (&optional arg slave) +(defun gnus-no-server-1 (&optional arg child) "Read network news. If ARG is a positive number, Gnus will use that as the startup level. If ARG is nil, Gnus will be started at level 2 @@ -739,11 +739,11 @@ and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. As opposed to \\[gnus], this command will not connect to the local server." (let ((val (or arg (1- gnus-level-default-subscribed)))) - (gnus val t slave) + (gnus val t child) (make-local-variable 'gnus-group-use-permanent-levels) (setq gnus-group-use-permanent-levels val))) -(defun gnus-1 (&optional arg dont-connect slave) +(defun gnus-1 (&optional arg dont-connect child) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the startup level. If ARG is non-nil and not a positive number, Gnus will @@ -761,7 +761,7 @@ prompt the user for the name of an NNTP server to use." (gnus-splash) (gnus-run-hooks 'gnus-before-startup-hook) (nnheader-init-server-buffer) - (setq gnus-slave slave) + (setq gnus-child child) (gnus-read-init-file) ;; Add "native" to gnus-predefined-server-alist just to have a @@ -790,7 +790,7 @@ prompt the user for the name of an NNTP server to use." (gnus-make-newsrc-file gnus-startup-file)) ;; Read the dribble file. - (when (or gnus-slave gnus-use-dribble-file) + (when (or gnus-child gnus-use-dribble-file) (gnus-dribble-read-file)) ;; Do the actual startup. @@ -1008,11 +1008,11 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Possibly eval the dribble file. (and init - (or gnus-use-dribble-file gnus-slave) + (or gnus-use-dribble-file gnus-child) (gnus-dribble-eval-file)) - ;; Slave Gnusii should then clear the dribble buffer. - (when (and init gnus-slave) + ;; Child Gnusii should then clear the dribble buffer. + (when (and init gnus-child) (gnus-dribble-clear)) (gnus-update-format-specifications) @@ -1030,7 +1030,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Find new newsgroups and treat them. (when (and init gnus-check-new-newsgroups (not level) (gnus-check-server gnus-select-method) - (not gnus-slave) + (not gnus-child) gnus-plugged) (gnus-find-new-newsgroups)) @@ -1040,8 +1040,8 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (gnus-server-opened gnus-select-method)) (gnus-check-bogus-newsgroups)) - ;; Read any slave files. - (gnus-master-read-slave-newsrc) + ;; Read any child files. + (gnus-parent-read-child-newsrc) ;; Find the number of unread articles in each non-dead group. (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) @@ -2111,6 +2111,7 @@ The info element is shared with the same element of ((string= gnus-ignored-newsgroups "") (delete-matching-lines "^to\\.")) (t + ;; relint suppression: Duplicated alternative branch (delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups)))) (goto-char (point-min)) @@ -2737,15 +2738,15 @@ values from `gnus-newsrc-hashtb', and write a new value of (gnus-agent-save-local force)) (save-excursion - (if (and (or gnus-use-dribble-file gnus-slave) + (if (and (or gnus-use-dribble-file gnus-child) (not force) (or (not (buffer-live-p gnus-dribble-buffer)) (zerop (with-current-buffer gnus-dribble-buffer (buffer-size))))) (gnus-message 4 "(No changes need to be saved)") (gnus-run-hooks 'gnus-save-newsrc-hook) - (if gnus-slave - (gnus-slave-save-newsrc) + (if gnus-child + (gnus-child-save-newsrc) ;; Save .newsrc only if the select method is an NNTP method. ;; The .newsrc file is for interoperability with other ;; newsreaders, so saving non-NNTP groups there doesn't make @@ -2988,55 +2989,61 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." ;;; -;;; Slave functions. +;;; Child functions. ;;; -(defvar gnus-slave-mode nil) +(defvar gnus-child-mode nil) -(defun gnus-slave-mode () - "Minor mode for slave Gnusae." - ;; FIXME: gnus-slave-mode appears to never be set (i.e. it'll always be nil): +(defun gnus-child-mode () + "Minor mode for child Gnusae." + ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil): ;; Remove, or fix and use define-minor-mode. - (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap)) - (gnus-run-hooks 'gnus-slave-mode-hook)) + (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap)) + (gnus-run-hooks 'gnus-child-mode-hook)) -(defun gnus-slave-save-newsrc () +(define-obsolete-function-alias 'gnus-slave-mode #'gnus-child-mode "28.1") +(define-obsolete-variable-alias 'gnus-slave-mode-hook 'gnus-child-mode-hook + "28.1") + +(defun gnus-child-save-newsrc () (with-current-buffer gnus-dribble-buffer (with-file-modes (or (ignore-errors (file-modes (concat gnus-current-startup-file ".eld"))) (default-file-modes)) - (let ((slave-name - (make-temp-file (concat gnus-current-startup-file "-slave-")))) + (let ((child-name + (make-temp-file (concat gnus-current-startup-file "-child-")))) (let ((coding-system-for-write gnus-ding-file-coding-system)) - (gnus-write-buffer slave-name)))))) + (gnus-write-buffer child-name)))))) -(defun gnus-master-read-slave-newsrc () - (let ((slave-files +(defun gnus-parent-read-child-newsrc () + (let ((child-files (directory-files (file-name-directory gnus-current-startup-file) t (concat "^" (regexp-quote - (concat - (file-name-nondirectory gnus-current-startup-file) - "-slave-"))) + (file-name-nondirectory gnus-current-startup-file)) + ;; When the obsolete variables like + ;; `gnus-slave-mode-hook' etc are removed, the "slave" + ;; bit of this regexp should also be removed. + "\\(-child-\\|-slave-\\)") t)) file) - (if (not slave-files) - () ; There are no slave files to read. - (gnus-message 7 "Reading slave newsrcs...") - (with-current-buffer (gnus-get-buffer-create " *gnus slave*") - (setq slave-files + (if (not child-files) + () ; There are no child files to read. + (gnus-message 7 "Reading child newsrcs...") + (with-current-buffer (gnus-get-buffer-create " *gnus child*") + (setq child-files (sort (mapcar (lambda (file) (list (file-attribute-modification-time (file-attributes file)) file)) - slave-files) + child-files) (lambda (f1 f2) (time-less-p (car f1) (car f2))))) - (while slave-files + (while child-files (erase-buffer) - (setq file (nth 1 (car slave-files))) + (setq file (nth 1 (car child-files))) (nnheader-insert-file-contents file) (when (condition-case () (progn @@ -3045,12 +3052,12 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." (error (gnus-error 3.2 "Possible error in %s" file) nil)) - (unless gnus-slave ; Slaves shouldn't delete these files. + (unless gnus-child ; Children shouldn't delete these files. (ignore-errors (delete-file file)))) - (setq slave-files (cdr slave-files)))) + (setq child-files (cdr child-files)))) (gnus-dribble-touch) - (gnus-message 7 "Reading slave newsrcs...done")))) + (gnus-message 7 "Reading child newsrcs...done")))) ;;; diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 341f04ad772..d731893ecec 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5352,7 +5352,8 @@ or a straight list of headers." ;; We remember that we probably want to output a dummy ;; root. (setq gnus-tmp-dummy-line gnus-tmp-header) - (setq gnus-tmp-prev-subject gnus-tmp-header)) + (setq gnus-tmp-prev-subject + (gnus-simplify-subject-fully gnus-tmp-header))) (t ;; We do not make a root for the gathered ;; sub-threads at all. @@ -7331,6 +7332,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-group-next-unread-group 1)) (setq group-point (point)) (gnus-article-stop-animations) + (unless leave-hidden + (gnus-configure-windows 'group 'force)) (if temporary nil ;Nothing to do. (set-buffer buf) @@ -7350,8 +7353,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (if quit-config (gnus-handle-ephemeral-exit quit-config) (goto-char group-point) - (unless leave-hidden - (gnus-configure-windows 'group 'force)) ;; If gnus-group-buffer is already displayed, make sure we also move ;; the cursor in the window that displays it. (let ((win (get-buffer-window (current-buffer) 0))) @@ -12508,10 +12509,15 @@ save those articles instead." "Save parts matching TYPE to DIR. If REVERSE, save parts that do not match TYPE." (interactive - (list (read-string "Save parts of type: " - (or (car gnus-summary-save-parts-type-history) - gnus-summary-save-parts-default-mime) - 'gnus-summary-save-parts-type-history) + (list (completing-read "Save parts of type: " + (progn + (gnus-summary-select-article nil t) + (gnus-eval-in-buffer-window gnus-article-buffer + (delete-dups + (mapcar (lambda (h) + (mm-handle-media-type (cdr h))) + gnus-article-mime-handle-alist)))) + nil nil nil 'gnus-summary-save-parts-type-history) (setq gnus-summary-save-parts-last-directory (read-directory-name "Save to directory: " gnus-summary-save-parts-last-directory diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index caeab7f55af..69f2bb27993 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2226,8 +2226,8 @@ Disabling the agent may result in noticeable loss of performance." :group 'gnus-start :type '(choice (function-item gnus) (function-item gnus-no-server) - (function-item gnus-slave) - (function-item gnus-slave-no-server))) + (function-item gnus-child) + (function-item gnus-child-no-server))) (declare-function gnus-group-get-new-news "gnus-group") @@ -2238,8 +2238,8 @@ Disabling the agent may result in noticeable loss of performance." :type '(choice (function-item gnus) (function-item gnus-group-get-new-news) (function-item gnus-no-server) - (function-item gnus-slave) - (function-item gnus-slave-no-server))) + (function-item gnus-child) + (function-item gnus-child-no-server))) (defcustom gnus-other-frame-parameters nil "Frame parameters used by `gnus-other-frame' to create a Gnus frame." @@ -2417,8 +2417,8 @@ such as a mark that says whether an article is stored in the cache (defvar gnus-article-buffer "*Article*") (defvar gnus-server-buffer "*Server*") -(defvar gnus-slave nil - "Whether this Gnus is a slave or not.") +(defvar gnus-child nil + "Whether this Gnus is a child or not.") (defvar gnus-batch-mode nil "Whether this Gnus is running in batch mode or not.") @@ -4034,13 +4034,20 @@ Allow completion over sensible values." ;;; User-level commands. ;;;###autoload +(defun gnus-child-no-server (&optional arg) + "Read network news as a child, without connecting to the local server." + (interactive "P") + (gnus-no-server arg t)) + +;;;###autoload (defun gnus-slave-no-server (&optional arg) - "Read network news as a slave, without connecting to the local server." + "Read network news as a child, without connecting to the local server." (interactive "P") (gnus-no-server arg t)) +(make-obsolete 'gnus-slave-no-server 'gnus-child-no-server "28.1") ;;;###autoload -(defun gnus-no-server (&optional arg slave) +(defun gnus-no-server (&optional arg child) "Read network news. If ARG is a positive number, Gnus will use that as the startup level. If ARG is nil, Gnus will be started at level 2. If ARG is non-nil @@ -4049,13 +4056,20 @@ an NNTP server to use. As opposed to `gnus', this command will not connect to the local server." (interactive "P") - (gnus-no-server-1 arg slave)) + (gnus-no-server-1 arg child)) + +;;;###autoload +(defun gnus-child (&optional arg) + "Read news as a child." + (interactive "P") + (gnus arg nil 'child)) ;;;###autoload (defun gnus-slave (&optional arg) - "Read news as a slave." + "Read news as a child." (interactive "P") - (gnus arg nil 'slave)) + (gnus arg nil 'child)) +(make-obsolete 'gnus-slave 'gnus-child "28.1") (defun gnus-delete-gnus-frame () "Delete gnus frame unless it is the only one. @@ -4116,7 +4130,7 @@ current display is used." (add-hook 'gnus-suspend-gnus-hook #'gnus-delete-gnus-frame))))) ;;;###autoload -(defun gnus (&optional arg dont-connect slave) +(defun gnus (&optional arg dont-connect child) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the startup level. If ARG is non-nil and not a positive number, Gnus will @@ -4130,7 +4144,7 @@ prompt the user for the name of an NNTP server to use." (message "You should byte-compile Gnus") (sit-for 2)) (let ((gnus-action-message-log (list nil))) - (gnus-1 arg dont-connect slave) + (gnus-1 arg dont-connect child) (gnus-final-warning))) (declare-function debbugs-gnu "ext:debbugs-gnu" diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 02d90603b40..a5c82447926 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -1263,7 +1263,17 @@ If SEND-IF-FORCE, only send authinfo to the server if the "nntpd" pbuffer nntp-address nntp-port-number :type (cadr (assoc nntp-open-connection-function map)) :end-of-command "^\\([2345]\\|[.]\\).*\n" - :capability-command "HELP\r\n" + :capability-command + (lambda (greeting) + (if (and greeting + (string-match "Typhoon" greeting)) + ;; Certain versions of the Typhoon server + ;; doesn't understand the CAPABILITIES + ;; command, but includes the capability + ;; data in the HELP command instead. + "HELP\r\n" + ;; Use the correct command for everything else. + "CAPABILITIES\r\n")) :success "^3" :starttls-function (lambda (capabilities) diff --git a/lisp/hexl.el b/lisp/hexl.el index cf7118f2089..38eca77e260 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -515,7 +515,7 @@ Ask the user for confirmation." (message "Current address is %d/0x%08x" hexl-address hexl-address)) hexl-address)) -(defun hexl-print-current-point-info () +(defun hexl-print-current-point-info (&rest _ignored) "Return current hexl-address in string. This function is intended to be used as eldoc callback." (let ((addr (hexl-current-address))) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 7f3dc4454ab..efbc0668553 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -208,7 +208,11 @@ This requires either the macOS \"open\" command, or the freedesktop ;;;###autoload (defun report-emacs-bug (topic &optional unused) "Report a bug in GNU Emacs. -Prompts for bug subject. Leaves you in a mail buffer." +Prompts for bug subject. Leaves you in a mail buffer. + +Already submitted bugs can be found in the Emacs bug tracker: + + https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1" (declare (advertised-calling-convention (topic) "24.5")) (interactive "sBug Subject: ") ;; The syntax `version;' is preferred to `[version]' because the @@ -270,7 +274,7 @@ Prompts for bug subject. Leaves you in a mail buffer." 'face 'link 'help-echo (concat "mouse-2, RET: Follow this link") 'action (lambda (button) - (browse-url "https://debbugs.gnu.org/")) + (browse-url "https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1")) 'follow-link t) (insert ". Please check that diff --git a/lisp/man.el b/lisp/man.el index 5278a1a84dd..8a36f3ac25d 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -996,7 +996,11 @@ An \"apropos\" query with -k gives a buffer of matching page names or descriptions. The pattern argument is usually an \"grep -E\" style regexp. - -k pattern" + -k pattern + +Note that in some cases you will need to use \\[quoted-insert] to quote the +SPC character in the above examples, because this command attempts +to auto-complete your input based on the installed manual pages." (interactive (list (let* ((default-entry (Man-default-man-entry)) diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el new file mode 100644 index 00000000000..f258d5cb9fb --- /dev/null +++ b/lisp/net/eudcb-macos-contacts.el @@ -0,0 +1,118 @@ +;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend + +;; Copyright (C) 2020 condition-alpha.com + +;; This program 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 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/>. + +;;; Commentary: +;; This library provides an interface to the macOS Contacts app as +;; an EUDC data source. It uses AppleScript to interface with the +;; Contacts app on localhost, so no 3rd party tools are needed. + +;;; Usage: +;; (require 'eudcb-macos-contacts) +;; (eudc-macos-contacts-set-server "localhost") + +;;; Code: + +(require 'eudc) +(require 'executable) + +;;{{{ Internal cooking + +(defvar eudc-macos-contacts-conversion-alist nil) + +;; hook ourselves into the EUDC framework +(eudc-protocol-set 'eudc-query-function + 'eudc-macos-contacts-query-internal + 'macos-contacts) +(eudc-protocol-set 'eudc-list-attributes-function + nil + 'macos-contacts) +(eudc-protocol-set 'eudc-macos-contacts-conversion-alist + nil + 'macos-contacts) +(eudc-protocol-set 'eudc-protocol-has-default-query-attributes + nil + 'macos-contacts) + +(defun eudc-macos-contacts-search-helper (str) + "Helper function to query the Contacts app via AppleScript. +Searches for all persons with a case-insensitive substring match +of STR in any of their name fields (first, middle, or last)." + (if (executable-find "osascript") + (call-process "osascript" nil t nil + "-e" + (format " +set results to {} +tell application \"Address Book\" + set pList to every person whose (name contains \"%s\") + repeat with pers in pList + repeat with emailAddr in emails of pers + set results to results & {name of pers & \":\" & value ¬ + of emailAddr & \"\n\"} + end repeat + end repeat + get results as text +end tell" str)) + (message (concat "[eudc] Error in macOS Contacts backend: " + "`osascript' executable not found. " + "Is this is a macOS 10.0 or later system?")))) + +(defun eudc-macos-contacts-query-internal (query &optional return-attrs) + "Query macOS Contacts with QUERY. +QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid +macOS Contacts attribute names. +RETURN-ATTRS is a list of attributes to return, defaulting to +`eudc-default-return-attributes'." + (let ((macos-contacts-buffer (get-buffer-create " *macOS Contacts*")) + result) + (with-current-buffer macos-contacts-buffer + (erase-buffer) + (dolist (term query) + (eudc-macos-contacts-search-helper (cdr term))) + (delete-duplicate-lines (point-min) (point-max)) + (goto-char (point-min)) + (while (not (eobp)) + (if (not (equal (line-beginning-position) (line-end-position))) + (let* ((args (split-string (buffer-substring + (point) (line-end-position)) + ":")) + (name (nth 0 args)) + (email (nth 1 args))) + (setq result (cons `((name . ,name) + (email . ,email)) result)))) + (forward-line)) + result))) + +;;}}} + +;;{{{ High-level interfaces (interactive functions) + +(defun eudc-macos-contacts-set-server (dummy) + "Set the EUDC server to macOS Contacts app. +The server in DUMMY is not actually used, since this backend +always and implicitly connetcs to an instance of the Contacts app +running on the local host." + (interactive) + (eudc-set-server dummy 'macos-contacts) + (message "[eudc] macOS Contacts app server selected")) + +;;}}} + +(eudc-register-protocol 'macos-contacts) + +(provide 'eudcb-macos-contacts) + +;;; eudcb-macos-contacts.el ends here diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2f6528de948..f4e3aa36c55 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -263,13 +263,17 @@ This list can be customized via `eww-suggest-uris'." (nreverse uris))) ;;;###autoload -(defun eww (url &optional arg) +(defun eww (url &optional arg buffer) "Fetch URL and render the page. If the input doesn't look like an URL or a domain name, the word(s) will be searched for via `eww-search-prefix'. If called with a prefix ARG, use a new buffer instead of reusing -the default EWW buffer." +the default EWW buffer. + +If BUFFER, the data to be rendered is in that buffer. In that +case, this function doesn't actually fetch URL. BUFFER will be +killed after rendering." (interactive (let* ((uris (eww-suggested-uris)) (prompt (concat "Enter URL or keywords" @@ -307,8 +311,12 @@ the default EWW buffer." (insert (format "Loading %s..." url)) (goto-char (point-min))) (let ((url-mime-accept-string eww-accept-content-types)) - (url-retrieve url #'eww-render - (list url nil (current-buffer))))) + (if buffer + (let ((eww-buffer (current-buffer))) + (with-current-buffer buffer + (eww-render nil url nil eww-buffer))) + (url-retrieve url #'eww-render + (list url nil (current-buffer)))))) (function-put 'eww 'browse-url-browser-kind 'internal) @@ -361,7 +369,19 @@ the default EWW buffer." (eww (concat "file://" (and (memq system-type '(windows-nt ms-dos)) "/") - (expand-file-name file)))) + (expand-file-name file)) + nil + ;; The file name may be a non-local Tramp file. The URL + ;; library doesn't understand these file names, so use the + ;; normal Emacs machinery to load the file. + (with-current-buffer (generate-new-buffer " *eww file*") + (set-buffer-multibyte nil) + (insert "Content-type: " (or (mailcap-extension-to-mime + (url-file-extension file)) + "application/octet-stream") + "\n\n") + (insert-file-contents file) + (current-buffer)))) ;;;###autoload (defun eww-search-words () @@ -1260,7 +1280,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (defun eww-tag-textarea (dom) (let ((start (point)) - (value (or (dom-attr dom 'value) "")) + (value (or (dom-text dom) "")) (lines (string-to-number (or (dom-attr dom 'rows) "10"))) (width (string-to-number (or (dom-attr dom 'cols) "10"))) end) @@ -1744,25 +1764,27 @@ If CHARSET is nil then use UTF-8." (insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n") (pp eww-bookmarks (current-buffer)))) -(defun eww-read-bookmarks () +(defun eww-read-bookmarks (&optional error-out) + "Read bookmarks from `eww-bookmarks'. +If ERROR-OUT, signal user-error if there are no bookmarks." (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory))) (setq eww-bookmarks (unless (zerop (or (file-attribute-size (file-attributes file)) 0)) (with-temp-buffer (insert-file-contents file) - (read (current-buffer))))))) + (read (current-buffer))))) + (when (and error-out (not eww-bookmarks)) + (user-error "No bookmarks are defined")))) ;;;###autoload (defun eww-list-bookmarks () "Display the bookmarks." (interactive) + (eww-read-bookmarks t) (pop-to-buffer "*eww bookmarks*") (eww-bookmark-prepare)) (defun eww-bookmark-prepare () - (eww-read-bookmarks) - (unless eww-bookmarks - (user-error "No bookmarks are defined")) (set-buffer (get-buffer-create "*eww bookmarks*")) (eww-bookmark-mode) (let* ((width (/ (window-width) 2)) @@ -1830,6 +1852,7 @@ If CHARSET is nil then use UTF-8." bookmark) (unless (get-buffer "*eww bookmarks*") (setq first t) + (eww-read-bookmarks t) (eww-bookmark-prepare)) (with-current-buffer (get-buffer "*eww bookmarks*") (when (and (not first) @@ -1848,6 +1871,7 @@ If CHARSET is nil then use UTF-8." bookmark) (unless (get-buffer "*eww bookmarks*") (setq first t) + (eww-read-bookmarks t) (eww-bookmark-prepare)) (with-current-buffer (get-buffer "*eww bookmarks*") (if first diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index cd86b4dea65..e713c94117b 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -105,12 +105,13 @@ Security'." (defcustom gnutls-trustfiles '( - "/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo and Arch Linux + "/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo, + ; Arch, Guix, Parabola "/etc/pki/tls/certs/ca-bundle.crt" ; Fedora and RHEL "/etc/ssl/ca-bundle.pem" ; Suse "/usr/ssl/certs/ca-bundle.crt" ; Cygwin "/usr/local/share/certs/ca-root-nss.crt" ; FreeBSD - "/etc/ssl/cert.pem" ; macOS + "/etc/ssl/cert.pem" ; macOS, Dragora, Parabola "/etc/certs/ca-certificates.crt" ; OpenIndiana ) "List of CA bundle location filenames or a function returning said list. diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 1c371f59870..e86426d4664 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -139,7 +139,10 @@ writes. See `make-network-process' for details. :capability-command specifies a command used to query the HOST for its capabilities. For instance, for IMAP this should be - \"1 CAPABILITY\\r\\n\". + \"1 CAPABILITY\\r\\n\". This can either be a string (which will + then be sent verbatim to the server), or a function (called with + a single parameter; the \"greeting\" from the server when connecting), + and should return a string to send to the server. :starttls-function specifies a function for handling STARTTLS. This function should take one parameter, the response to the @@ -280,8 +283,11 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." :coding (plist-get parameters :coding))) (greeting (and (not (plist-get parameters :nogreeting)) (network-stream-get-response stream start eoc))) - (capabilities (network-stream-command stream capability-command - eo-capa)) + (capabilities + (network-stream-command + stream + (network-stream--capability-command capability-command greeting) + eo-capa)) (resulting-type 'plain) starttls-available starttls-command error) @@ -329,7 +335,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." ;; Requery capabilities for protocols that require it; i.e., ;; EHLO for SMTP. (when (plist-get parameters :always-query-capabilities) - (network-stream-command stream capability-command eo-capa))) + (network-stream-command + stream + (network-stream--capability-command capability-command greeting) + eo-capa))) (when (let ((response (network-stream-command stream starttls-command eoc))) (and response (string-match success-string response))) @@ -365,7 +374,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." host service)) ;; Re-get the capabilities, which may have now changed. (setq capabilities - (network-stream-command stream capability-command eo-capa)))) + (network-stream-command + stream + (network-stream--capability-command capability-command greeting) + eo-capa)))) ;; If TLS is mandatory, close the connection if it's unencrypted. (when (and require-tls @@ -428,7 +440,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." parameters) (require 'tls) (open-tls-stream name buffer host service))) - (eoc (plist-get parameters :end-of-command))) + (eoc (plist-get parameters :end-of-command)) + greeting) (if (plist-get parameters :nowait) (list stream nil nil 'tls) ;; Check certificate validity etc. @@ -440,17 +453,22 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." ;; openssl/gnutls-cli. (when (and (not (gnutls-available-p)) eoc) - (network-stream-get-response stream start eoc) + (setq greeting (network-stream-get-response stream start eoc)) (goto-char (point-min)) (when (re-search-forward eoc nil t) (goto-char (match-beginning 0)) (delete-region (point-min) (line-beginning-position)))) - (let ((capability-command (plist-get parameters :capability-command)) + (let ((capability-command + (plist-get parameters :capability-command)) (eo-capa (or (plist-get parameters :end-of-capability) eoc))) (list stream (network-stream-get-response stream start eoc) - (network-stream-command stream capability-command eo-capa) + (network-stream-command + stream + (network-stream--capability-command + capability-command greeting) + eo-capa) 'tls))))))) (defun network-stream-open-shell (name buffer host service parameters) @@ -464,21 +482,29 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (format-spec (plist-get parameters :shell-command) `((?s . ,host) - (?p . ,service))))))) + (?p . ,service)))))) + greeting) (when coding (if (consp coding) - (set-process-coding-system stream - (car coding) - (cdr coding)) (set-process-coding-system stream - coding - coding))) + (car coding) + (cdr coding)) + (set-process-coding-system stream + coding + coding))) (list stream - (network-stream-get-response stream start eoc) - (network-stream-command stream capability-command - (or (plist-get parameters :end-of-capability) - eoc)) + (setq greeting (network-stream-get-response stream start eoc)) + (network-stream-command + stream + (network-stream--capability-command capability-command greeting) + (or (plist-get parameters :end-of-capability) + eoc)) 'plain))) +(defun network-stream--capability-command (command greeting) + (if (functionp command) + (funcall command greeting) + command)) + (provide 'network-stream) ;;; network-stream.el ends here diff --git a/lisp/net/shr.el b/lisp/net/shr.el index a3f04968a27..ddd81127213 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -95,15 +95,31 @@ If nil, don't draw horizontal table lines." :type 'character) (defcustom shr-width nil - "Frame width to use for rendering. + "Window width to use for HTML rendering. May either be an integer specifying a fixed width in characters, -or nil, meaning that the full width of the window should be used. -If `shr-use-fonts' is set, the mean character width is used to -compute the pixel width, which is used instead." +or nil, meaning use the full width of the window. +If `shr-use-fonts' is set, the value is interpreted as a multiple +of the mean character width of the default face's font. + +Also see `shr-max-width'." :version "25.1" :type '(choice (integer :tag "Fixed width in characters") (const :tag "Use the width of the window" nil))) +(defcustom shr-max-width 120 + "Maximum text width to use for HTML rendering. +May either be an integer specifying a fixed width in characters, +or nil, meaning that there is no width limit. + +If `shr-use-fonts' is set, the value of this variable is +interpreted as a multiple of the mean character width of the +default face's font. + +If `shr-width' is non-nil, it overrides this variable." + :version "28.1" + :type '(choice (integer :tag "Fixed width in characters") + (const :tag "No width limit" nil))) + (defcustom shr-bullet "* " "Bullet used for unordered lists. Alternative suggestions are: @@ -267,30 +283,37 @@ DOM should be a parse tree as generated by (shr-table-separator-pixel-width (shr-string-pixel-width "-")) (shr-internal-bullet (cons shr-bullet (shr-string-pixel-width shr-bullet))) - (shr-internal-width (or (and shr-width - (if (not shr-use-fonts) - shr-width - (* shr-width (frame-char-width)))) - ;; We need to adjust the available - ;; width for when the user disables - ;; the fringes, which will cause the - ;; display engine usurp one column for - ;; the continuation glyph. - (if (not shr-use-fonts) - (- (window-body-width) 1 - (if (and (null shr-width) - (not (shr--have-one-fringe-p))) - 0 - 1)) - (- (window-body-width nil t) - (* 2 (frame-char-width)) - (if (and (null shr-width) - (not (shr--have-one-fringe-p))) - (* (frame-char-width) 2) - 0) - 1)))) + (shr-internal-width + (if shr-width + ;; Specified width; use it. + (if (not shr-use-fonts) + shr-width + (* shr-width (frame-char-width))) + ;; Compute the width based on the window width. We need to + ;; adjust the available width for when the user disables + ;; the fringes, which will cause the display engine usurp + ;; one column for the continuation glyph. + (if (not shr-use-fonts) + (- (window-body-width) 1 + (if (shr--have-one-fringe-p) + 1 + 0)) + (- (window-body-width nil t) + (* 2 (frame-char-width)) + (if (shr--have-one-fringe-p) + 0 + (* (frame-char-width) 2)) + 1)))) (max-specpdl-size max-specpdl-size) bidi-display-reordering) + ;; Adjust for max width specification. + (when (and shr-max-width + (not shr-width)) + (setq shr-internal-width + (min shr-internal-width + (if shr-use-fonts + (* shr-max-width (frame-char-width)) + shr-max-width)))) ;; If the window was hscrolled for some reason, shr-fill-lines ;; below will misbehave, because it silently assumes that it ;; starts with a non-hscrolled window (vertical-motion will move @@ -2576,12 +2599,28 @@ flags that control whether to collect or render objects." i)) (defun shr-max-columns (dom) - (let ((max 0)) + (let ((max 0) + (this 0) + (rowspans nil)) (dolist (row (dom-children dom)) (when (and (not (stringp row)) (eq (dom-tag row) 'tr)) - (setq max (max max (+ (shr-count row 'td) - (shr-count row 'th)))))) + (setq this 0) + (dolist (column (dom-children row)) + (when (and (not (stringp column)) + (memq (dom-tag column) '(td th))) + (setq this (+ 1 this (length rowspans))) + ;; We have a rowspan, which we emulate later in rendering + ;; by adding an extra column to the following rows. + (when-let* ((span (dom-attr column 'rowspan))) + (push (string-to-number span) rowspans)))) + (setq max (max max this))) + ;; Count down the rowspans in effect. + (let ((new nil)) + (dolist (span rowspans) + (when (> span 1) + (push (1- span) new))) + (setq rowspans new))) max)) (provide 'shr) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index a7a5047ed49..c1eb36e3405 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,15 +55,27 @@ It is used for TCP/IP devices." "When this method name is used, forward all calls to Android Debug Bridge.") ;;;###tramp-autoload -(defcustom tramp-adb-prompt - "^[[:digit:]]*|?[[:alnum:]\e;[]*@?[[:alnum:]]*[^#\\$]*[#\\$][[:space:]]" +(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]" "Regexp used as prompt in almquist shell." :type 'regexp - :version "24.4" + :version "28.1" :group 'tramp) +(eval-and-compile + (defconst tramp-adb-ls-date-year-regexp + "[[:digit:]]\\{4\\}-[[:digit:]]\\{2\\}-[[:digit:]]\\{2\\}" + "Regexp for date year format in ls output.")) + +(eval-and-compile + (defconst tramp-adb-ls-date-time-regexp + "[[:digit:]]\\{2\\}:[[:digit:]]\\{2\\}" + "Regexp for date time format in ls output.")) + (defconst tramp-adb-ls-date-regexp - "[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]" + (concat + "[[:space:]]" tramp-adb-ls-date-year-regexp + "[[:space:]]" tramp-adb-ls-date-time-regexp + "[[:space:]]") "Regexp for date format in ls output.") (defconst tramp-adb-ls-toolbox-regexp @@ -73,7 +85,8 @@ It is used for TCP/IP devices." "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size - "[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date + "[[:space:]]+\\(" tramp-adb-ls-date-year-regexp + "[[:space:]]" tramp-adb-ls-date-time-regexp "\\)" ; \5 date "[[:space:]]\\(.*\\)$") ; \6 filename "Regexp for ls output.") @@ -215,11 +228,10 @@ ARGUMENTS to pass to the OPERATION." (goto-char (point-min)) (forward-line) (when (looking-at - (eval-when-compile - (concat "[[:space:]]*[^[:space:]]+" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)"))) + (concat "[[:space:]]*[^[:space:]]+" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)")) ;; The values are given as 1k numbers, so we must change ;; them to number of bytes. (list (* 1024 (string-to-number (match-string 1))) @@ -272,7 +284,9 @@ ARGUMENTS to pass to the OPERATION." (if (eq id-format 'integer) 0 uid) (if (eq id-format 'integer) 0 gid) tramp-time-dont-know ; atime - (date-to-time date) ; mtime + ;; `date-to-time' checks `iso8601-parse', which might fail. + (let (signal-hook-function) + (date-to-time date)) ; mtime tramp-time-dont-know ; ctime size mod-string @@ -351,21 +365,6 @@ ARGUMENTS to pass to the OPERATION." "ls --color=never") (t "ls")))) -(defun tramp-adb--gnu-switches-to-ash (switches) - "Almquist shell can't handle multiple arguments. -Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"." - (split-string - (apply #'concat - (mapcar (lambda (s) - (replace-regexp-in-string - "\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s))) - ;; FIXME: Warning about removed switches (long and non-dash). - (delq nil - (mapcar - (lambda (s) - (and (not (string-match-p "\\(^--\\|^[^-]\\)" s)) s)) - switches)))))) - (defun tramp-adb-sh-fix-ls-output (&optional sort-by-time) "Insert dummy 0 in empty size columns. Android's \"ls\" command doesn't insert size column for directories: @@ -375,10 +374,16 @@ Emacs dired can't find files." (goto-char (point-min)) (while (search-forward-regexp - "[[:space:]]\\([[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]]\\)" nil t) + (eval-when-compile + (concat + "[[:space:]]" + "\\([[:space:]]" tramp-adb-ls-date-year-regexp "[[:space:]]\\)")) + nil t) (replace-match "0\\1" "\\1" nil) ;; Insert missing "/". - (when (looking-at-p "[0-9][0-9]:[0-9][0-9][[:space:]]+$") + (when (looking-at-p + (eval-when-compile + (concat tramp-adb-ls-date-time-regexp "[[:space:]]+$"))) (end-of-line) (insert "/"))) ;; Sort entries. @@ -489,9 +494,10 @@ Emacs dired can't find files." (with-tramp-progress-reporter v 3 (format "Fetching %s to tmp file %s" filename tmpfile) ;; "adb pull ..." does not always return an error code. - (when (or (tramp-adb-execute-adb-command - v "pull" (tramp-compat-file-name-unquote localname) tmpfile) - (not (file-exists-p tmpfile))) + (unless + (and (tramp-adb-execute-adb-command + v "pull" (tramp-compat-file-name-unquote localname) tmpfile) + (file-exists-p tmpfile)) (ignore-errors (delete-file tmpfile)) (tramp-error v 'file-error "Cannot make local copy of file `%s'" filename)) @@ -544,8 +550,8 @@ But handle the case, if the \"test\" command is not available." v 3 (format-message "Moving tmp file `%s' to `%s'" tmpfile filename) (unwind-protect - (when (tramp-adb-execute-adb-command - v "push" tmpfile (tramp-compat-file-name-unquote localname)) + (unless (tramp-adb-execute-adb-command + v "push" tmpfile (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Cannot write: `%s'" filename)) (delete-file tmpfile))) @@ -577,7 +583,7 @@ But handle the case, if the \"test\" command is not available." (unless (and (eq flag 'nofollow) (file-symlink-p filename)) (tramp-flush-file-properties v localname) (tramp-adb-send-command-and-check - v (format "chmod %o %s" mode localname))))) + v (format "chmod %o %s" mode (tramp-shell-quote-argument localname)))))) (defun tramp-adb-handle-set-file-times (filename &optional time flag) "Like `set-file-times' for Tramp files." @@ -595,15 +601,16 @@ But handle the case, if the \"test\" command is not available." ;; fails. Also, fall back on old POSIX 'touch -t' if 'touch -d' ;; (introduced in POSIX.1-2008) fails. (tramp-adb-send-command-and-check - v (format (concat "touch -d %s %s %s 2>/dev/null || " - "touch -d %s %s %s 2>/dev/null || " - "touch -t %s %s %s") - (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t) - nofollow quoted-name - (format-time-string "%Y-%m-%dT%H:%M:%S" time t) - nofollow quoted-name - (format-time-string "%Y%m%d%H%M.%S" time t) - nofollow quoted-name))))) + v (format + (concat "touch -d %s %s %s 2>/dev/null || " + "touch -d %s %s %s 2>/dev/null || " + "touch -t %s %s %s") + (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t) + nofollow quoted-name + (format-time-string "%Y-%m-%dT%H:%M:%S" time t) + nofollow quoted-name + (format-time-string "%Y%m%d%H%M.%S" time t) + nofollow quoted-name))))) (defun tramp-adb-handle-copy-file (filename newname &optional ok-if-already-exists keep-date @@ -670,10 +677,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; because `file-attributes' reads the values from ;; there. (tramp-flush-file-properties v localname) - (when (tramp-adb-execute-adb-command - v "push" - (tramp-compat-file-name-unquote filename) - (tramp-compat-file-name-unquote localname)) + (unless (tramp-adb-execute-adb-command + v "push" + (tramp-compat-file-name-unquote filename) + (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Cannot copy `%s' `%s'" filename newname)))))))) @@ -1039,10 +1046,10 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" ;; Try to connect device. ((and tramp-adb-connect-if-not-connected (not (zerop (length host))) - (not (tramp-adb-execute-adb-command - vec "connect" - (replace-regexp-in-string - tramp-prefix-port-format ":" host)))) + (tramp-adb-execute-adb-command + vec "connect" + (replace-regexp-in-string + tramp-prefix-port-format ":" host))) ;; When new device connected, running other adb command (e.g. ;; adb shell) immediately will fail. To get around this ;; problem, add sleep 0.1 second here. @@ -1052,18 +1059,18 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" vec 'file-error "Could not find device %s" host))))))) (defun tramp-adb-execute-adb-command (vec &rest args) - "Return nil on success error-output on failure." + "Execute an adb command. +Insert the result into the connection buffer. Return nil on +error and non-nil on success." (when (and (> (length (tramp-file-name-host vec)) 0) ;; The -s switch is only available for ADB device commands. (not (member (car args) '("connect" "disconnect")))) (setq args (append (list "-s" (tramp-adb-get-device vec)) args))) - (with-temp-buffer - (prog1 - (unless - (zerop - (apply #'tramp-call-process vec tramp-adb-program nil t nil args)) - (buffer-string)) - (tramp-message vec 6 "%s" (buffer-string))))) + (with-current-buffer (tramp-get-connection-buffer vec) + ;; Clean up the buffer. We cannot call `erase-buffer' because + ;; narrowing might be in effect. + (let ((inhibit-read-only t)) (delete-region (point-min) (point-max))) + (zerop (apply #'tramp-call-process vec tramp-adb-program nil t nil args)))) (defun tramp-adb-find-test-command (vec) "Check whether the ash has a builtin \"test\" command. @@ -1075,25 +1082,30 @@ This happens for Android >= 4.0." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (unless neveropen (tramp-adb-maybe-open-connection vec)) - (tramp-message vec 6 "%s" command) - (tramp-send-string vec command) - (unless nooutput - ;; FIXME: Race condition. - (tramp-adb-wait-for-output (tramp-get-connection-process vec)) - (with-current-buffer (tramp-get-connection-buffer vec) - (save-excursion - (goto-char (point-min)) - ;; We can't use stty to disable echo of command. stty is said - ;; to be added to toybox 0.7.6. busybox shall have it, but this - ;; isn't used any longer for Android. - (delete-matching-lines (regexp-quote command)) - ;; When the local machine is W32, there are still trailing ^M. - ;; There must be a better solution by setting the correct coding - ;; system, but this requires changes in core Tramp. - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" nil nil)))))) + (if (string-match-p "[[:multibyte:]]" command) + ;; Multibyte codepoints with four bytes are not supported at + ;; least by toybox. + (tramp-adb-execute-adb-command vec "shell" command) + + (unless neveropen (tramp-adb-maybe-open-connection vec)) + (tramp-message vec 6 "%s" command) + (tramp-send-string vec command) + (unless nooutput + ;; FIXME: Race condition. + (tramp-adb-wait-for-output (tramp-get-connection-process vec)) + (with-current-buffer (tramp-get-connection-buffer vec) + (save-excursion + (goto-char (point-min)) + ;; We can't use stty to disable echo of command. stty is said + ;; to be added to toybox 0.7.6. busybox shall have it, but this + ;; isn't used any longer for Android. + (delete-matching-lines (regexp-quote command)) + ;; When the local machine is W32, there are still trailing ^M. + ;; There must be a better solution by setting the correct coding + ;; system, but this requires changes in core Tramp. + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" nil nil))))))) (defun tramp-adb-send-command-and-check (vec command &optional exit-status) "Run COMMAND and check its exit status. @@ -1108,7 +1120,7 @@ the exit status." (format "%s; echo tramp_exit_status $?" command) "echo tramp_exit_status $?")) (with-current-buffer (tramp-get-connection-buffer vec) - (unless (tramp-search-regexp "tramp_exit_status [0-9]+") + (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+") (tramp-error vec 'file-error "Couldn't find exit status of `%s'" command)) (skip-chars-forward "^ ") @@ -1217,7 +1229,11 @@ connection if a previous connection has died for some reason." ;; connection properties. We start again. (tramp-message vec 5 "Checking system information") (tramp-adb-send-command - vec "echo \\\"`getprop ro.product.model` `getprop ro.product.version` `getprop ro.build.version.release`\\\"") + vec + (concat + "echo \\\"`getprop ro.product.model` " + "`getprop ro.product.version` " + "`getprop ro.build.version.release`\\\"")) (let ((old-getprop (tramp-get-connection-property vec "getprop" nil)) (new-getprop @@ -1241,7 +1257,8 @@ connection if a previous connection has died for some reason." (tramp-adb-send-command vec (format "su %s" user)) (unless (tramp-adb-send-command-and-check vec nil) (delete-process p) - (tramp-flush-file-property vec "" "su-command-p") + ;; Do not flush, we need the nil value. + (tramp-set-file-property vec "" "su-command-p" nil) (tramp-error vec 'file-error "Cannot switch to user `%s'" user))) @@ -1275,4 +1292,9 @@ connection if a previous connection has died for some reason." (provide 'tramp-adb) +;;; TODO: +;; +;; * Support file names with multibyte codepoints. Use as fallback +;; "adb shell COMMAND". +;; ;;; tramp-adb.el ends here diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 2805f6648ce..52cc186ecf7 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -359,9 +359,8 @@ The remote connection identified by SOURCE is flushed by (or (setq target (tramp-default-rename-file source)) (tramp-user-error nil - (eval-when-compile - (concat "There is no target specified. " - "Check `tramp-default-rename-alist' for a proper entry."))))) + (concat "There is no target specified. " + "Check `tramp-default-rename-alist' for a proper entry.")))) (when (tramp-equal-remote source target) (tramp-user-error nil "Source and target must have different remote.")) @@ -566,11 +565,10 @@ buffer in your bug report. ;; Remove string quotation. (forward-line -1) (when (looking-at - (eval-when-compile - (concat "\\(^.*\\)" "\"" ;; \1 " - "\\((base64-decode-string \\)" "\\\\" ;; \2 \ - "\\(\".*\\)" "\\\\" ;; \3 \ - "\\(\")\\)" "\"$"))) ;; \4 " + (concat "\\(^.*\\)" "\"" ;; \1 " + "\\((base64-decode-string \\)" "\\\\" ;; \2 \ + "\\(\".*\\)" "\\\\" ;; \3 \ + "\\(\")\\)" "\"$")) ;; \4 " (replace-match "\\1\\2\\3\\4") (beginning-of-line) (insert " ;; Variable encoded due to non-printable characters.\n")) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 95ae1569dc9..996a92454f1 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -31,8 +31,7 @@ (require 'tramp) ;; Pacify byte-compiler. -(eval-when-compile - (require 'custom)) +(eval-when-compile (require 'custom)) (defvar ange-ftp-ftp-name-arg) (defvar ange-ftp-ftp-name-res) (defvar ange-ftp-name-format) @@ -79,9 +78,9 @@ present for backward compatibility." ;;; This regexp recognizes absolute filenames with only one component ;;; on Windows, for the sake of hostname completion. (and (memq system-type '(ms-dos windows-nt)) - (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist) + (or (assoc "^[[:alpha:]]:/[^/:]*\\'" file-name-handler-alist) (setq file-name-handler-alist - (cons '("^[a-zA-Z]:/[^/:]*\\'" . + (cons '("^[:alpha:]]:/[^/:]*\\'" . ange-ftp-completion-hook-function) file-name-handler-alist))))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index dce6edd19c4..6467d8f88b4 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -108,8 +108,7 @@ (require 'url-util) ;; Pacify byte-compiler. -(eval-when-compile - (require 'custom)) +(eval-when-compile (require 'custom)) (declare-function zeroconf-init "zeroconf") (declare-function zeroconf-list-service-types "zeroconf") @@ -697,32 +696,34 @@ It has been changed in GVFS 1.14.") "List of cons cells, mapping \"gvfs-<command>\" to \"gio <command>\".") ;; <http://www.pygtk.org/docs/pygobject/gio-constants.html> -(defconst tramp-gvfs-file-attributes - '("name" - "type" - "standard::display-name" - "standard::symlink-target" - "standard::is-volatile" - "unix::nlink" - "unix::uid" - "owner::user" - "unix::gid" - "owner::group" - "time::access" - "time::modified" - "time::changed" - "standard::size" - "unix::mode" - "access::can-read" - "access::can-write" - "access::can-execute" - "unix::inode" - "unix::device") - "GVFS file attributes.") - -(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)") - "Regexp to parse GVFS file attributes with `gvfs-ls'.") +(eval-and-compile + (defconst tramp-gvfs-file-attributes + '("name" + "type" + "standard::display-name" + "standard::symlink-target" + "standard::is-volatile" + "unix::nlink" + "unix::uid" + "owner::user" + "unix::gid" + "owner::group" + "time::access" + "time::modified" + "time::changed" + "standard::size" + "unix::mode" + "access::can-read" + "access::can-write" + "access::can-execute" + "unix::inode" + "unix::device") + "GVFS file attributes.")) + +(eval-and-compile + (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp + (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)") + "Regexp to parse GVFS file attributes with `gvfs-ls'.")) (defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp (concat "^[[:blank:]]*" @@ -864,7 +865,7 @@ pass to the OPERATION." (defun tramp-gvfs-dbus-string-to-byte-array (string) "Like `dbus-string-to-byte-array' but add trailing \\0 if needed." (dbus-string-to-byte-array - (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature) + (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature) (concat string (string 0)) string))) (defun tramp-gvfs-dbus-byte-array-to-string (byte-array) @@ -1181,10 +1182,11 @@ file names." (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (looking-at - (concat "^\\(.+\\)[[:blank:]]" - "\\([[:digit:]]+\\)[[:blank:]]" - "(\\(.+?\\))" - tramp-gvfs-file-attributes-with-gvfs-ls-regexp)) + (eval-when-compile + (concat "^\\(.+\\)[[:blank:]]" + "\\([[:digit:]]+\\)[[:blank:]]" + "(\\(.+?\\))" + tramp-gvfs-file-attributes-with-gvfs-ls-regexp))) (let ((item (list (cons "type" (match-string 3)) (cons "standard::size" (match-string 2)) (cons "name" (match-string 1))))) @@ -1285,8 +1287,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (if (eq id-format 'integer) (string-to-number (or (cdr (assoc "unix::uid" attributes)) - (eval-when-compile - (format "%s" tramp-unknown-id-integer)))) + (eval-when-compile (format "%s" tramp-unknown-id-integer)))) (or (cdr (assoc "owner::user" attributes)) (cdr (assoc "unix::uid" attributes)) tramp-unknown-id-string))) @@ -1294,8 +1295,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (if (eq id-format 'integer) (string-to-number (or (cdr (assoc "unix::gid" attributes)) - (eval-when-compile - (format "%s" tramp-unknown-id-integer)))) + (eval-when-compile (format "%s" tramp-unknown-id-integer)))) (or (cdr (assoc "owner::group" attributes)) (cdr (assoc "unix::gid" attributes)) tramp-unknown-id-string))) @@ -1475,11 +1475,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." ;; File names are returned as URL paths. We must convert them. (when (string-match ddu file) (setq file (replace-match dd nil nil file))) - (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" file) + (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" file) (setq file (url-unhex-string file))) (when (string-match ddu (or file1 "")) (setq file1 (replace-match dd nil nil file1))) - (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" (or file1 "")) + (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" (or file1 "")) (setq file1 (url-unhex-string file1))) ;; Remove watch when file or directory to be watched is deleted. (when (and (member action '(moved deleted)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 89e5dc9e658..0e55d603a3b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -90,10 +90,10 @@ the default storage location, e.g. \"$HOME/.sh_history\"." (string :tag "Redirect to a file"))) ;;;###tramp-autoload -(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m" +(defconst tramp-display-escape-sequence-regexp "\e[[:digit:];[]+m" "Terminal control escape sequences for display attributes.") -(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n" +(defconst tramp-device-escape-sequence-regexp "\e[[:digit:][]+n" "Terminal control escape sequences for device status.") ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for @@ -1329,13 +1329,12 @@ component is used as the target of the symlink." (tramp-send-command-and-read vec (format - (eval-when-compile - (concat - ;; Apostrophes in the stat output are masked as - ;; `tramp-stat-marker', in order to make a proper shell escape - ;; of them in file names. - "(%s -c '((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' %s |" - " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g')")) + (concat + ;; Apostrophes in the stat output are masked as + ;; `tramp-stat-marker', in order to make a proper shell escape of + ;; them in file names. + "(%s -c '((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' %s |" + " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g')") (tramp-get-remote-stat vec) tramp-stat-marker tramp-stat-marker (if (eq id-format 'integer) @@ -1514,9 +1513,8 @@ ID-FORMAT valid values are `string' and `integer'." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (eval-when-compile - (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" - "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))) + (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):" + "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)"))) (when (and (tramp-remote-selinux-p v) (tramp-send-command-and-check v (format @@ -1766,21 +1764,19 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-send-command-and-read vec (format - (eval-when-compile - (concat - ;; We must care about file names with spaces, or starting with - ;; "-"; this would confuse xargs. "ls -aQ" might be a - ;; solution, but it does not work on all remote systems. - ;; Therefore, we use \000 as file separator. - ;; `tramp-sh--quoting-style-options' do not work for file names - ;; with spaces piped to "xargs". - ;; Apostrophes in the stat output are masked as - ;; `tramp-stat-marker', in order to make a proper shell escape - ;; of them in file names. - "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | " - "xargs -0 %s -c " - "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " - "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")) + (concat + ;; We must care about file names with spaces, or starting with + ;; "-"; this would confuse xargs. "ls -aQ" might be a solution, + ;; but it does not work on all remote systems. Therefore, we use + ;; \000 as file separator. `tramp-sh--quoting-style-options' do + ;; not work for file names with spaces piped to "xargs". + ;; Apostrophes in the stat output are masked as + ;; `tramp-stat-marker', in order to make a proper shell escape of + ;; them in file names. + "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | " + "xargs -0 %s -c " + "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " + "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"") (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) ;; On systems which have no quoting style, file names with special @@ -1821,13 +1817,12 @@ ID-FORMAT valid values are `string' and `integer'." (format "tramp_perl_file_name_all_completions %s" (tramp-shell-quote-argument localname))) - (format (eval-when-compile - (concat - "(cd %s 2>&1 && %s -a 2>/dev/null" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>/dev/null;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" - " && \\echo ok) || \\echo fail")) + (format (concat + "(cd %s 2>&1 && %s -a 2>/dev/null" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>/dev/null;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" + " && \\echo ok) || \\echo fail") (tramp-shell-quote-argument localname) (tramp-get-ls-command v) (tramp-get-test-command v)))) @@ -3387,9 +3382,8 @@ STDERR can also be a file name." loc-enc tmpfile t)) (tramp-error v 'file-error - (eval-when-compile - (concat "Cannot write to `%s', " - "local encoding command `%s' failed")) + (concat "Cannot write to `%s', " + "local encoding command `%s' failed") filename loc-enc)))) ;; Send buffer into remote decoding command which @@ -3434,9 +3428,8 @@ STDERR can also be a file name." (buffer-string)))) (tramp-error v 'file-error - (eval-when-compile - (concat "Couldn't write region to `%s'," - " decode using `%s' failed")) + (concat "Couldn't write region to `%s'," + " decode using `%s' failed") filename rem-dec))))) ;; Save exit. @@ -3446,9 +3439,8 @@ STDERR can also be a file name." (t (tramp-error v 'file-error - (eval-when-compile - (concat "Method `%s' should specify both encoding and " - "decoding command or an scp program")) + (concat "Method `%s' should specify both encoding and " + "decoding command or an scp program") method)))) ;; Make `last-coding-system-used' have the right value. @@ -3648,13 +3640,11 @@ Fall back to normal file name handler if no Tramp handler exists." events (cond ((and (memq 'change flags) (memq 'attribute-change flags)) - (eval-when-compile - (concat "create,modify,move,moved_from,moved_to,move_self," - "delete,delete_self,attrib,ignored"))) + (concat "create,modify,move,moved_from,moved_to,move_self," + "delete,delete_self,attrib,ignored")) ((memq 'change flags) - (eval-when-compile - (concat "create,modify,move,moved_from,moved_to,move_self," - "delete,delete_self,ignored"))) + (concat "create,modify,move,moved_from,moved_to,move_self," + "delete,delete_self,ignored")) ((memq 'attribute-change flags) "attrib,ignored")) sequence `(,command "-mq" "-e" ,events ,localname) ;; Make events a list of symbols. @@ -3796,12 +3786,11 @@ Fall back to normal file name handler if no Tramp handler exists." "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string)) (while (string-match - (eval-when-compile - (concat "^[\n\r]*" - "Directory Monitor Event:[\n\r]+" - "Child = \\([^\n\r]+\\)[\n\r]+" - "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?" - "Event = \\([^[:blank:]]+\\)[\n\r]+")) + (concat "^[\n\r]*" + "Directory Monitor Event:[\n\r]+" + "Child = \\([^\n\r]+\\)[\n\r]+" + "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?" + "Event = \\([^[:blank:]]+\\)[\n\r]+") string) (let* ((file (match-string 1 string)) (file1 (match-string 3 string)) @@ -3837,10 +3826,9 @@ Fall back to normal file name handler if no Tramp handler exists." (dolist (line (split-string string "[\n\r]+" 'omit)) ;; Check, whether there is a problem. (unless (string-match - (eval-when-compile - (concat "^[^[:blank:]]+" - "[[:blank:]]+\\([^[:blank:]]+\\)" - "\\([[:blank:]]+\\([^\n\r]+\\)\\)?")) + (concat "^[^[:blank:]]+" + "[[:blank:]]+\\([^[:blank:]]+\\)" + "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") line) (tramp-error proc 'file-notify-error "%s" line)) @@ -3876,11 +3864,10 @@ Fall back to normal file name handler if no Tramp handler exists." (goto-char (point-min)) (forward-line) (when (looking-at - (eval-when-compile - (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?" - "[[:space:]]*\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)"))) + (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?" + "[[:space:]]*\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)")) (mapcar (lambda (d) (* d (tramp-get-connection-property v "df-blocksize" 0))) @@ -3949,6 +3936,9 @@ hosts, or files, disagree." (tramp-shell-quote-argument v1-localname) (tramp-shell-quote-argument v2-localname)))))) +(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11")) + "Regexp to determine remote SunOS.") + (defun tramp-find-executable (vec progname dirlist &optional ignore-tilde ignore-path) "Search for PROGNAME in $PATH and all directories mentioned in DIRLIST. @@ -3970,7 +3960,7 @@ This function expects to be in the right *tramp* buffer." ;; therefore. (unless (or ignore-path (string-match-p - (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11"))) + tramp-sunos-unames (tramp-get-connection-property vec "uname" ""))) (tramp-send-command vec (format "which \\%s | wc -w" progname)) (goto-char (point-min)) @@ -3988,12 +3978,11 @@ This function expects to be in the right *tramp* buffer." (setq dirlist (nreverse newdl)))) (tramp-send-command vec - (format (eval-when-compile - (concat "while read d; " - "do if test -x $d/%s && test -f $d/%s; " - "then echo tramp_executable $d/%s; " - "break; fi; done <<'%s'\n" - "%s\n%s")) + (format (concat "while read d; " + "do if test -x $d/%s && test -f $d/%s; " + "then echo tramp_executable $d/%s; " + "break; fi; done <<'%s'\n" + "%s\n%s") progname progname progname tramp-end-of-heredoc (string-join dirlist "\n") @@ -4146,10 +4135,9 @@ file exists and nonzero exit status otherwise." ;; initial probes to ensure the remote shell is usable.) (tramp-send-command vec (format - (eval-when-compile - (concat - "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' " - "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s")) + (concat + "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' " + "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s") tramp-terminal-type (or (getenv "INSIDE_EMACS") emacs-version) tramp-version (or (getenv-internal "ENV" tramp-remote-process-environment) "") @@ -4199,8 +4187,7 @@ file exists and nonzero exit status otherwise." ;; and Solaris is buggy. We've got reports ;; for "SunOS 5.10" and "SunOS 5.11" so far. (string-match-p - (eval-when-compile - (regexp-opt '("SunOS 5.10" "SunOS 5.11"))) + tramp-sunos-unames (tramp-get-connection-property vec "uname" ""))) (or (tramp-find-executable @@ -4212,10 +4199,9 @@ file exists and nonzero exit status otherwise." default-shell (tramp-message vec 2 - (eval-when-compile - (concat - "Couldn't find a remote shell which groks tilde " - "expansion, using `%s'")) + (concat + "Couldn't find a remote shell which groks tilde " + "expansion, using `%s'") default-shell))) default-shell))) @@ -5223,7 +5209,7 @@ the exit status." "echo tramp_exit_status $?" (if subshell " )" ""))) (with-current-buffer (tramp-get-connection-buffer vec) - (unless (tramp-search-regexp "tramp_exit_status [0-9]+") + (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+") (tramp-error vec 'file-error "Couldn't find exit status of `%s'" command)) (skip-chars-forward "^ ") @@ -5627,8 +5613,7 @@ Nonexistent directories are removed from spec." ;; stat on Solaris is buggy. We've got reports for "SunOS 5.10" ;; and "SunOS 5.11" so far. (unless (string-match-p - (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11"))) - (tramp-get-connection-property vec "uname" "")) + tramp-sunos-unames (tramp-get-connection-property vec "uname" "")) (tramp-message vec 5 "Finding a suitable `stat' command") (let ((result (tramp-find-executable vec "stat" (tramp-get-remote-path vec))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 947e6a767c7..1b6af2a2e33 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -875,23 +875,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (while (not (eobp)) (cond ((looking-at - "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)") + (concat + "Size:\\s-+\\([[:digit:]]+\\)\\s-+" + "Blocks:\\s-+[[:digit:]]+\\s-+\\(\\w+\\)")) (setq size (string-to-number (match-string 1)) id (if (string-equal "directory" (match-string 2)) t (if (string-equal "symbolic" (match-string 2)) "")))) ((looking-at - "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)") + "Inode:\\s-+\\([[:digit:]]+\\)\\s-+Links:\\s-+\\([[:digit:]]+\\)") (setq inode (string-to-number (match-string 1)) link (string-to-number (match-string 2)))) ((looking-at - "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)") + (concat + "Access:\\s-+([[:digit:]]+/\\(\\S-+\\))\\s-+" + "Uid:\\s-+\\([[:digit:]]+\\)\\s-+" + "Gid:\\s-+\\([[:digit:]]+\\)")) (setq mode (match-string 1) uid (if (equal id-format 'string) (match-string 2) (string-to-number (match-string 2))) gid (if (equal id-format 'string) (match-string 3) (string-to-number (match-string 3))))) ((looking-at - "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") + (concat + "Access:\\s-+" + "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+" + "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)")) (setq atime (encode-time (string-to-number (match-string 6)) ;; sec @@ -901,7 +909,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-to-number (match-string 2)) ;; month (string-to-number (match-string 1))))) ;; year ((looking-at - "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") + (concat + "Modify:\\s-+" + "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+" + "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)")) (setq mtime (encode-time (string-to-number (match-string 6)) ;; sec @@ -911,7 +922,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-to-number (match-string 2)) ;; month (string-to-number (match-string 1))))) ;; year ((looking-at - "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") + (concat + "Change:\\s-+" + "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+" + "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)")) (setq ctime (encode-time (string-to-number (match-string 6)) ;; sec @@ -987,10 +1001,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (goto-char (point-min)) (forward-line) (when (looking-at - (eval-when-compile - (concat "[[:space:]]*\\([[:digit:]]+\\)" - " blocks of size \\([[:digit:]]+\\)" - "\\. \\([[:digit:]]+\\) blocks available"))) + (concat "[[:space:]]*\\([[:digit:]]+\\)" + " blocks of size \\([[:digit:]]+\\)" + "\\. \\([[:digit:]]+\\) blocks available")) (setq blocksize (string-to-number (match-string 2)) total (* blocksize (string-to-number (match-string 1))) avail (* blocksize (string-to-number (match-string 3))))) @@ -1474,7 +1487,7 @@ component is used as the target of the symlink." ;; This is meant for traces, and returning from the ;; function. No error is propagated outside, due to ;; the `ignore-errors' closure. - (unless (tramp-search-regexp "tramp_exit_status [0-9]+") + (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+") (tramp-error v 'file-error "Couldn't find exit status of `%s'" tramp-smb-acl-program)) @@ -1719,21 +1732,21 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." ;; Entries provided by smbclient DIR aren't fully regular. ;; They should have the format ;; -;; \s-\{2,2} - leading spaces +;; \s-\{2,2\} - leading spaces ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound ;; \s- - space delimiter -;; \s-+[0-9]+ - size, 8 chars, right bound +;; \s-+[[:digit:]]+ - size, 8 chars, right bound ;; \s-\{2,2\} - space delimiter ;; \w\{3,3\} - weekday ;; \s- - space delimiter ;; \w\{3,3\} - month ;; \s- - space delimiter -;; [ 12][0-9] - day +;; [ 12][[:digit:]] - day ;; \s- - space delimiter -;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time +;; [[:digit:]]\{2,2\}:[[:digit:]]\{2,2\}:[[:digit:]]\{2,2\} - time ;; \s- - space delimiter -;; [0-9]\{4,4\} - year +;; [[:digit:]]\{4,4\} - year ;; ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html) ;; has function display_finfo: @@ -1781,13 +1794,14 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-block nil ;; year. - (if (string-match "\\([0-9]+\\)$" line) + (if (string-match "\\([[:digit:]]+\\)$" line) (setq year (string-to-number (match-string 1 line)) line (substring line 0 -5)) (cl-return)) ;; time. - (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line) + (if (string-match + "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)$" line) (setq hour (string-to-number (match-string 1 line)) min (string-to-number (match-string 2 line)) sec (string-to-number (match-string 3 line)) @@ -1795,7 +1809,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-return)) ;; day. - (if (string-match "\\([0-9]+\\)$" line) + (if (string-match "\\([[:digit:]]+\\)$" line) (setq day (string-to-number (match-string 1 line)) line (substring line 0 -3)) (cl-return)) @@ -1812,7 +1826,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-return)) ;; size. - (if (string-match "\\([0-9]+\\)$" line) + (if (string-match "\\([[:digit:]]+\\)$" line) (let ((length (- (max 10 (1+ (length (match-string 1 line))))))) (setq size (string-to-number (match-string 1 line))) (when (string-match diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 05242ffd970..98727dc4a87 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -488,9 +488,8 @@ the result will be a local, non-Tramp, file name." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (eval-when-compile - (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" - "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)")))) + (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):" + "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)"))) (when (and (tramp-sudoedit-remote-selinux-p v) (tramp-sudoedit-send-command v "ls" "-d" "-Z" @@ -515,10 +514,9 @@ the result will be a local, non-Tramp, file name." (goto-char (point-min)) (forward-line) (when (looking-at - (eval-when-compile - (concat "[[:space:]]*\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)"))) + (concat "[[:space:]]*\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)")) (list (string-to-number (match-string 1)) ;; The second value is the used size. We need the ;; free size. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1566162feaf..19cf3334502 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -560,7 +560,7 @@ Sometimes the prompt is reported to look like \"login as:\"." ;; Allow also [] style prompts. They can appear only during ;; connection initialization; Tramp redefines the prompt afterwards. (concat "\\(?:^\\|\r\\)" - "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*") + "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[[:digit:];]*[[:alpha:]] *\\)*") "Regexp to match prompts from remote shell. Normally, Tramp expects you to configure `shell-prompt-pattern' correctly, but sometimes it happens that you are connecting to a @@ -601,7 +601,7 @@ The `sudo' program appears to insert a `^@' character into the prompt." "\\|" "^.*\\(" ;; Here comes a list of regexes, separated by \\| - "Received signal [0-9]+" + "Received signal [[:digit:]]+" "\\).*") "Regexp matching a `login failed' message. The regexp should match at end of buffer." @@ -797,9 +797,9 @@ Used in `tramp-make-tramp-file-name'.") Should always start with \"^\". Derived from `tramp-prefix-format'.") (defconst tramp-method-regexp-alist - '((default . "[a-zA-Z0-9-]+") + '((default . "[[:alnum:]-]+") (simplified . "") - (separate . "[a-zA-Z0-9-]*")) + (separate . "[[:alnum:]-]*")) "Alist mapping Tramp syntax to regexps matching methods identifiers.") (defun tramp-build-method-regexp () @@ -843,7 +843,7 @@ Derived from `tramp-postfix-method-format'.") "Regexp matching delimiter between user and domain names. Derived from `tramp-prefix-domain-format'.") -(defconst tramp-domain-regexp "[a-zA-Z0-9_.-]+" +(defconst tramp-domain-regexp "[[:alnum:]_.-]+" "Regexp matching domain names.") (defconst tramp-user-with-domain-regexp @@ -860,7 +860,7 @@ Used in `tramp-make-tramp-file-name'.") "Regexp matching delimiter between user and host names. Derived from `tramp-postfix-user-format'.") -(defconst tramp-host-regexp "[a-zA-Z0-9_.%-]+" +(defconst tramp-host-regexp "[[:alnum:]_.%-]+" "Regexp matching host names.") (defconst tramp-prefix-ipv6-format-alist @@ -888,7 +888,7 @@ Derived from `tramp-prefix-ipv6-format'.") ;; The following regexp is a bit sloppy. But it shall serve our ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in ;; "::ffff:192.168.0.1". -(defconst tramp-ipv6-regexp "\\(?:[a-zA-Z0-9]*:\\)+[a-zA-Z0-9.]+" +(defconst tramp-ipv6-regexp "\\(?:[[:alnum:]]*:\\)+[[:alnum:].]+" "Regexp matching IPv6 addresses.") (defconst tramp-postfix-ipv6-format-alist @@ -920,7 +920,7 @@ Derived from `tramp-postfix-ipv6-format'.") "Regexp matching delimiter between host names and port numbers. Derived from `tramp-prefix-port-format'.") -(defconst tramp-port-regexp "[0-9]+" +(defconst tramp-port-regexp "[[:digit:]]+" "Regexp matching port numbers.") (defconst tramp-host-with-port-regexp @@ -1684,11 +1684,10 @@ version, the function does nothing." (format "*debug tramp/%s %s*" method host-port)))) (defconst tramp-debug-outline-regexp - (eval-when-compile - (concat - "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ " ;; Timestamp. - "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread. - "[a-z0-9-]+ (\\([0-9]+\\)) #")) ;; Function name, verbosity. + (concat + "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp. + "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread. + "[[:alnum:]-]+ (\\([[:digit:]]+\\)) #") ;; Function name, verbosity. "Used for highlighting Tramp debug buffers in `outline-mode'.") (defconst tramp-debug-font-lock-keywords @@ -2013,9 +2012,11 @@ without a visible progress reporter." (tramp-message ,vec ,level "%s..." ,message) (let ((cookie "failed") (tm - ;; We start a pulsing progress reporter after 3 - ;; seconds. Display only when there is a minimum level. - (when-let ((pr (and (<= ,level (min tramp-verbose 3)) + ;; We start a pulsing progress reporter after 3 seconds. + ;; Start only when there is no other progress reporter + ;; running, and when there is a minimum level. + (when-let ((pr (and (null tramp-inhibit-progress-reporter) + (<= ,level (min tramp-verbose 3)) (make-progress-reporter ,message nil nil)))) (run-at-time 3 0.1 #'tramp-progress-reporter-update pr)))) (unwind-protect @@ -2074,7 +2075,7 @@ letter into the file name. This function removes it." (save-match-data (let ((quoted (tramp-compat-file-name-quoted-p name 'top)) (result (tramp-compat-file-name-unquote name 'top))) - (setq result (if (string-match "\\`[a-zA-Z]:/" result) + (setq result (if (string-match "\\`[[:alpha:]]:/" result) (replace-match "/" nil t result) result)) (if quoted (tramp-compat-file-name-quote result 'top) result)))) @@ -2938,7 +2939,7 @@ User is always nil." "Return a list of (user host) tuples allowed to access. User is always nil." (tramp-parse-shostkeys-sknownhosts - dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))) + dirname (concat "^key_[[:digit:]]+_\\(" tramp-host-regexp "\\)\\.pub$"))) (defun tramp-parse-sknownhosts (dirname) "Return a list of (user host) tuples allowed to access. @@ -3255,12 +3256,13 @@ User is always nil." (let ((candidate (tramp-compat-file-name-unquote (directory-file-name filename))) + case-fold-search tmpfile) ;; Check, whether we find an existing file with ;; lower case letters. This avoids us to create a ;; temporary file. (while (and (string-match-p - "[a-z]" (tramp-file-local-name candidate)) + "[[:lower:]]" (tramp-file-local-name candidate)) (not (file-exists-p candidate))) (setq candidate (directory-file-name @@ -3269,8 +3271,8 @@ User is always nil." ;; for comparison. `make-nearby-temp-file' is added ;; to Emacs 26+ like `file-name-case-insensitive-p', ;; so there is no compatibility problem calling it. - (unless - (string-match-p "[a-z]" (tramp-file-local-name candidate)) + (unless (string-match-p + "[[:lower:]]" (tramp-file-local-name candidate)) (setq tmpfile (let ((default-directory (file-name-directory filename))) @@ -4225,10 +4227,9 @@ performed successfully. Any other value means an error." (tramp-get-connection-buffer vec))) ((eq exit 'process-died) (substitute-command-keys - (eval-when-compile - (concat - "Tramp failed to connect. If this happens repeatedly, try\n" - " `\\[tramp-cleanup-this-connection]'")))) + (concat + "Tramp failed to connect. If this happens repeatedly, try\n" + " `\\[tramp-cleanup-this-connection]'"))) ((eq exit 'timeout) (format-message "Timeout reached, see buffer `%s' for details" diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 9df51c1242a..b88ea0af82c 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -230,7 +230,7 @@ and apply it if applicable." (throw 'found t))))))))) (defvar bug-reference-setup-from-mail-alist - `((,(regexp-opt '("emacs" "auctex" "gnus") 'words) + `((,(regexp-opt '("emacs" "auctex" "gnus" "tramp" "orgmode") 'words) ,(regexp-opt '("@debbugs.gnu.org" "-devel@gnu.org" ;; List-Id of Gnus devel mailing list. "ding.gnus.org")) @@ -343,6 +343,65 @@ and set it if applicable." (push val header-values)))))) (bug-reference--maybe-setup-from-mail nil header-values))))))) +(defvar bug-reference-setup-from-irc-alist + `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc" + "erc") 'words)) + "freenode" + "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)" + "https://debbugs.gnu.org/%s")) + "An alist for setting up `bug-reference-mode' in IRC modes. + +This takes action if `bug-reference-mode' is enabled in IRC +channels using one of Emacs' IRC clients (rcirc and ERC). +Currently, only rcirc is supported. + +Each element has the form + + (CHANNEL-REGEXP SERVER-REGEXP BUG-REGEXP URL-FORMAT) + +CHANNEL-REGEXP is a regexp matched against the current mail IRC +channel name. SERVER-REGEXP is matched against the IRC server +name. If any of those matches, BUG-REGEXP is set as +`bug-reference-bug-regexp' and URL-FORMAT is set as +`bug-reference-url-format'.") + +(defun bug-reference--maybe-setup-from-irc (channel server) + "Set up according to IRC CHANNEL or SERVER. +CHANNEL is an IRC channel name and SERVER is that channel's +server name. + +If any CHANNEL-REGEXP or SERVER-REGEXP of +`bug-reference-setup-from-irc-alist' matches CHANNEL or SERVER, +the corresponding BUG-REGEXP and URL-FORMAT are set." + (catch 'setup-done + (dolist (config bug-reference-setup-from-irc-alist) + (when (or + (and channel + (car config) + (string-match-p (car config) channel)) + (and server + (nth 1 config) + (string-match-p (car config) server))) + (setq-local bug-reference-bug-regexp (nth 2 config)) + (setq-local bug-reference-url-format (nth 3 config)) + (throw 'setup-done t))))) + +(defvar rcirc-target) +(defvar rcirc-server-buffer) +(defvar rcirc-server) + +(defun bug-reference-try-setup-from-rcirc () + "Try setting up `bug-reference-mode' based on rcirc channel and server. +Test each configuration in `bug-reference-setup-from-irc-alist' +and set it if applicable." + (when (derived-mode-p 'rcirc-mode) + (bug-reference--maybe-setup-from-irc + rcirc-target + (and rcirc-server-buffer + (buffer-live-p rcirc-server-buffer) + (with-current-buffer rcirc-server-buffer + rcirc-server))))) + (defun bug-reference--run-auto-setup () (when (or bug-reference-mode bug-reference-prog-mode) @@ -354,7 +413,8 @@ and set it if applicable." "Error during bug-reference auto-setup: %S" (catch 'setup (dolist (f (list #'bug-reference-try-setup-from-vc - #'bug-reference-try-setup-from-gnus)) + #'bug-reference-try-setup-from-gnus + #'bug-reference-try-setup-from-rcirc)) (when (funcall f) (throw 'setup t)))))))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 1977eadb5c6..c3a98d9c5cf 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1582,6 +1582,7 @@ comment at the start of cc-engine.el for more info." (save-excursion (backward-char) (looking-at "\\s(")) (c-crosses-statement-barrier-p (point) end))))) +(make-obsolete 'c-at-expression-start-p nil "CC mode 5.35") ;; A set of functions that covers various idiosyncrasies in @@ -3186,6 +3187,24 @@ comment at the start of cc-engine.el for more info." c-semi-near-cache-limit (min c-semi-near-cache-limit pos) c-full-near-cache-limit (min c-full-near-cache-limit pos))) +(defun c-foreign-truncate-lit-pos-cache (beg _end) + "Truncate CC Mode's literal cache. + +This function should be added to the `before-change-functions' +hook by major modes that use CC Mode's filling functionality +without initializing CC Mode. Currently (2020-06) these are +js-mode and mhtml-mode." + (c-truncate-lit-pos-cache beg)) + +(defun c-foreign-init-lit-pos-cache () + "Initialize CC Mode's literal cache. + +This function should be called from the mode functions of major +modes which use CC Mode's filling functionality without +initializing CC Mode. Currently (2020-06) these are js-mode and +mhtml-mode." + (c-truncate-lit-pos-cache 1)) + ;; A system for finding noteworthy parens before the point. @@ -11877,17 +11896,6 @@ comment at the start of cc-engine.el for more info." (cons (list beg) type))))) (error nil)))) -(defun c-looking-at-bos (&optional _lim) - ;; Return non-nil if between two statements or declarations, assuming - ;; point is not inside a literal or comment. - ;; - ;; Obsolete - `c-at-statement-start-p' or `c-at-expression-start-p' - ;; are recommended instead. - ;; - ;; This function might do hidden buffer changes. - (c-at-statement-start-p)) -(make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1") - (defun c-looking-at-statement-block () ;; Point is at an opening brace. If this is a statement block (i.e. the ;; elements in the block are terminated by semicolons, or the block is diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 814a85c72a6..b77bf3303b6 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1769,7 +1769,7 @@ ender." `comment-start-skip' is initialized from this." ;; Default: Allow the last char of the comment starter(s) to be ;; repeated, then allow any amount of horizontal whitespace. - t (concat "\\(" + t (concat "\\(?:" (c-concat-separated (mapcar (lambda (cs) (when cs diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 92c1ce89b8c..81bcd101fe4 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2337,68 +2337,48 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; line was fouled up by context fontification. (save-restriction (widen) - (let (new-beg new-end new-region case-fold-search string-fence-beg lim) - ;; Check how far back we need to extend the region where we reapply the - ;; string fence syntax-table properties. These must be in place for the - ;; coming fontification operations. - (save-excursion - (goto-char (if c-in-after-change-fontification - (min beg c-new-BEG) - beg)) - (setq lim (max (- (point) 500) (point-min))) - (while + (let (new-beg new-end new-region case-fold-search) + (c-save-buffer-state nil + ;; Temporarily reapply the string fence syntax-table properties. + (unwind-protect (progn - (skip-chars-backward "^\"" lim) - (or (bobp) (backward-char)) - (save-excursion - (eq (logand (skip-chars-backward "\\\\") 1) 1)))) - (setq string-fence-beg - (cond ((c-get-char-property (point) 'c-fl-syn-tab) - (point)) - (c-in-after-change-fontification - c-new-BEG) - (t beg))) - (c-save-buffer-state nil - ;; Temporarily reapply the string fence syntax-table properties. - (unwind-protect - (progn - (c-restore-string-fences) - (if (and c-in-after-change-fontification - (< beg c-new-END) (> end c-new-BEG)) - ;; Region and the latest after-change fontification region overlap. - ;; Determine the upper and lower bounds of our adjusted region - ;; separately. - (progn - (if (<= beg c-new-BEG) - (setq c-in-after-change-fontification nil)) - (setq new-beg - (if (and (>= beg (c-point 'bol c-new-BEG)) - (<= beg c-new-BEG)) - ;; Either jit-lock has accepted `c-new-BEG', or has - ;; (probably) extended the change region spuriously - ;; to BOL, which position likely has a - ;; syntactically different position. To ensure - ;; correct fontification, we start at `c-new-BEG', - ;; assuming any characters to the left of - ;; `c-new-BEG' on the line do not require - ;; fontification. - c-new-BEG - (setq new-region (c-before-context-fl-expand-region beg end) - new-end (cdr new-region)) - (car new-region))) - (setq new-end - (if (and (>= end (c-point 'bol c-new-END)) - (<= end c-new-END)) - c-new-END - (or new-end - (cdr (c-before-context-fl-expand-region beg end)))))) - ;; Context (etc.) fontification. - (setq new-region (c-before-context-fl-expand-region beg end) - new-beg (car new-region) new-end (cdr new-region))) - ;; Finally invoke font lock's functionality. - (funcall (default-value 'font-lock-fontify-region-function) - new-beg new-end verbose)) - (c-clear-string-fences))))))) + (c-restore-string-fences) + (if (and c-in-after-change-fontification + (< beg c-new-END) (> end c-new-BEG)) + ;; Region and the latest after-change fontification region overlap. + ;; Determine the upper and lower bounds of our adjusted region + ;; separately. + (progn + (if (<= beg c-new-BEG) + (setq c-in-after-change-fontification nil)) + (setq new-beg + (if (and (>= beg (c-point 'bol c-new-BEG)) + (<= beg c-new-BEG)) + ;; Either jit-lock has accepted `c-new-BEG', or has + ;; (probably) extended the change region spuriously + ;; to BOL, which position likely has a + ;; syntactically different position. To ensure + ;; correct fontification, we start at `c-new-BEG', + ;; assuming any characters to the left of + ;; `c-new-BEG' on the line do not require + ;; fontification. + c-new-BEG + (setq new-region (c-before-context-fl-expand-region beg end) + new-end (cdr new-region)) + (car new-region))) + (setq new-end + (if (and (>= end (c-point 'bol c-new-END)) + (<= end c-new-END)) + c-new-END + (or new-end + (cdr (c-before-context-fl-expand-region beg end)))))) + ;; Context (etc.) fontification. + (setq new-region (c-before-context-fl-expand-region beg end) + new-beg (car new-region) new-end (cdr new-region))) + ;; Finally invoke font lock's functionality. + (funcall (default-value 'font-lock-fontify-region-function) + new-beg new-end verbose)) + (c-clear-string-fences)))))) (defun c-after-font-lock-init () ;; Put on `font-lock-mode-hook'. This function ensures our after-change diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index f25b3cb9e2b..a8fe485b702 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -1294,10 +1294,10 @@ Calls `cfengine-cf-promises' with \"-s json\"." 'symbols)) syntax))) -(defun cfengine3-documentation-function () +(defun cfengine3-documentation-function (&rest _ignored) "Document CFengine 3 functions around point. -Intended as the value of `eldoc-documentation-function', which see. -Use it by enabling `eldoc-mode'." +Intended as the value of `eldoc-documentation-functions', which +see. Use it by enabling `eldoc-mode'." (let ((fdef (cfengine3--current-function))) (when fdef (cfengine3-format-function-docstring fdef)))) @@ -1390,15 +1390,8 @@ to the action header." (when buffer-file-name (shell-quote-argument buffer-file-name))))) - (if (boundp 'eldoc-documentation-functions) - (add-hook 'eldoc-documentation-functions - #'cfengine3-documentation-function nil t) - ;; For emacs < 25.1 where `eldoc-documentation-function' defaults - ;; to nil. - (or eldoc-documentation-function - (setq-local eldoc-documentation-function #'ignore)) - (add-function :before-until (local 'eldoc-documentation-function) - #'cfengine3-documentation-function)) + (add-hook 'eldoc-documentation-functions + #'cfengine3-documentation-function nil t) (add-hook 'completion-at-point-functions #'cfengine3-completion-function nil t) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 8812c49ba43..6df54111911 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -280,7 +280,9 @@ Blank lines separate paragraphs. Semicolons start comments. electric-pair-text-pairs)) (add-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs)) (add-hook 'eldoc-documentation-functions - #'elisp-eldoc-documentation-function nil t) + #'elisp-eldoc-var-docstring nil t) + (add-hook 'eldoc-documentation-functions + #'elisp-eldoc-funcall nil t) (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) (setq-local project-vc-external-roots-function #'elisp-load-path-roots) (add-hook 'completion-at-point-functions @@ -1403,20 +1405,27 @@ which see." or argument string for functions. 2 - `function' if function args, `variable' if variable documentation.") -(defun elisp-eldoc-documentation-function () - "`eldoc-documentation-function' (which see) for Emacs Lisp." - (let ((current-symbol (elisp--current-symbol)) - (current-fnsym (elisp--fnsym-in-current-sexp))) - (cond ((null current-fnsym) - nil) - ((eq current-symbol (car current-fnsym)) - (or (apply #'elisp-get-fnsym-args-string current-fnsym) - (elisp-get-var-docstring current-symbol))) - (t - (or (elisp-get-var-docstring current-symbol) - (apply #'elisp-get-fnsym-args-string current-fnsym)))))) - -(defun elisp-get-fnsym-args-string (sym &optional index prefix) +(defun elisp-eldoc-funcall (callback &rest _ignored) + "Document function call at point. +Intended for `eldoc-documentation-functions' (which see)." + (let* ((sym-info (elisp--fnsym-in-current-sexp)) + (fn-sym (car sym-info))) + (when fn-sym + (funcall callback (apply #'elisp-get-fnsym-args-string sym-info) + :thing fn-sym + :face (if (functionp fn-sym) + 'font-lock-function-name-face + 'font-lock-keyword-face))))) + +(defun elisp-eldoc-var-docstring (callback &rest _ignored) + "Document variable at point. +Intended for `eldoc-documentation-functions' (which see)." + (let ((sym (elisp--current-symbol))) + (when sym (funcall callback (elisp-get-var-docstring sym) + :thing sym + :face 'font-lock-variable-name-face)))) + +(defun elisp-get-fnsym-args-string (sym &optional index) "Return a string containing the parameter list of the function SYM. If SYM is a subr and no arglist is obtainable from the docstring or elsewhere, return a 1-line docstring." @@ -1442,20 +1451,13 @@ or elsewhere, return a 1-line docstring." ;; Stringify, and store before highlighting, downcasing, etc. (elisp--last-data-store sym (elisp-function-argstring args) 'function)))))) - ;; Highlight, truncate. + ;; Highlight (if argstring (elisp--highlight-function-argument - sym argstring index - (or prefix - (concat (propertize (symbol-name sym) 'face - (if (functionp sym) - 'font-lock-function-name-face - 'font-lock-keyword-face)) - ": ")))))) - -(defun elisp--highlight-function-argument (sym args index prefix) - "Highlight argument INDEX in ARGS list for function SYM. -In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." + sym argstring index)))) + +(defun elisp--highlight-function-argument (sym args index) + "Highlight argument INDEX in ARGS list for function SYM." ;; FIXME: This should probably work on the list representation of `args' ;; rather than its string representation. ;; FIXME: This function is much too long, we need to split it up! @@ -1558,7 +1560,6 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (when start (setq doc (copy-sequence args)) (add-text-properties start end (list 'face argument-face) doc)) - (setq doc (eldoc-docstring-format-sym-doc prefix doc)) doc))) ;; Return a string containing a brief (one-line) documentation string for @@ -1571,9 +1572,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (t (let ((doc (documentation-property sym 'variable-documentation t))) (when doc - (let ((doc (eldoc-docstring-format-sym-doc - sym (elisp--docstring-first-line doc) - 'font-lock-variable-name-face))) + (let ((doc (elisp--docstring-first-line doc))) (elisp--last-data-store sym doc 'variable))))))) (defun elisp--last-data-store (symbol doc type) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 4ca5c657650..37e73241e5d 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -4,9 +4,9 @@ ;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> ;; Maintainer: João Távora <joaotavora@gmail.com> -;; Version: 1.0.8 +;; Version: 1.0.9 ;; Keywords: c languages tools -;; Package-Requires: ((emacs "26.1")) +;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0")) ;; This is a GNU ELPA :core package. Avoid functionality that is not ;; compatible with the version of Emacs recorded above. @@ -1002,6 +1002,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (add-hook 'after-change-functions 'flymake-after-change-function nil t) (add-hook 'after-save-hook 'flymake-after-save-hook nil t) (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) + (add-hook 'eldoc-documentation-functions 'flymake-eldoc-function nil t) ;; If Flymake happened to be alrady already ON, we must cleanup ;; existing diagnostic overlays, lest we forget them by blindly @@ -1019,6 +1020,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (remove-hook 'after-save-hook 'flymake-after-save-hook t) (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) + (remove-hook 'eldoc-documentation-functions 'flymake-eldoc-function t) (mapc #'delete-overlay (flymake--overlays)) @@ -1086,6 +1088,14 @@ START and STOP and LEN are as in `after-change-functions'." (flymake-mode) (flymake-log :warning "Turned on in `flymake-find-file-hook'"))) +(defun flymake-eldoc-function (report-doc &rest _) + "Document diagnostics at point. +Intended for `eldoc-documentation-functions' (which see)." + (let ((diags (flymake-diagnostics (point)))) + (when diags + (funcall report-doc + (mapconcat #'flymake-diagnostic-text diags "\n"))))) + (defun flymake-goto-next-error (&optional n filter interactive) "Go to Nth next Flymake diagnostic that matches FILTER. Interactively, always move to the next diagnostic. With a prefix diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index eb43e8b7e44..092d15983e5 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -2620,9 +2620,9 @@ comint mode, which see." (select-window (display-buffer (get-buffer-create (concat "*gud" filepart "*")) - '(display-buffer-reuse-window - display-buffer-in-previous-window - display-buffer-same-window display-buffer-pop-up-window))) + '((display-buffer-reuse-window + display-buffer-in-previous-window + display-buffer-same-window display-buffer-pop-up-window)))) (when (and existing-buffer (get-buffer-process existing-buffer)) (error "This program is already being debugged")) ;; Set the dir, in case the buffer already existed with a different dir. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 04b449ecd2c..5c50e2accdf 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4570,7 +4570,7 @@ This function is intended for use in `after-change-functions'." ;; Comments (setq-local comment-start "// ") - (setq-local comment-start-skip "\\(//+\\|/\\*+\\)\\s *") + (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") (setq-local comment-end "") (setq-local fill-paragraph-function #'js-fill-paragraph) (setq-local normal-auto-fill-function #'js-do-auto-fill) @@ -4591,6 +4591,8 @@ This function is intended for use in `after-change-functions'." (setq imenu-create-index-function #'js--imenu-create-index) ;; for filling, pretend we're cc-mode + (c-foreign-init-lit-pos-cache) + (add-hook 'before-change-functions #'c-foreign-truncate-lit-pos-cache nil t) (setq-local comment-line-break-function #'c-indent-new-comment-line) (setq-local comment-multi-line t) (setq-local electric-indent-chars diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 352c1810d1f..e07f818a68a 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -755,7 +755,7 @@ Key bindings: (setq font-lock-defaults '(inferior-octave-font-lock-keywords nil nil)) (setq-local info-lookup-mode 'octave-mode) - (setq-local eldoc-documentation-function 'octave-eldoc-function) + (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t) (setq-local comint-input-ring-file-name (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist")) @@ -1639,8 +1639,8 @@ code line." (nreverse result))))) (cdr octave-eldoc-cache)) -(defun octave-eldoc-function () - "A function for `eldoc-documentation-function' (which see)." +(defun octave-eldoc-function (&rest _ignored) + "A function for `eldoc-documentation-functions' (which see)." (when (inferior-octave-process-live-p) (let* ((ppss (syntax-ppss)) (paren-pos (cadr ppss)) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 0a15939d243..a0930553bd7 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. -;; Version: 0.4.0 +;; Version: 0.5.0 ;; Package-Requires: ((emacs "26.3")) ;; This is a GNU ELPA :core package. Avoid using functionality that @@ -37,11 +37,29 @@ ;; current project, without having to know which package handles ;; detection of that project type, parsing its config files, etc. ;; -;; Infrastructure: +;; This file consists of following parts: ;; -;; Function `project-current', to determine the current project -;; instance, and 4 (at the moment) generic functions that act on it. -;; This list is to be extended in future versions. +;; Infrastructure (the public API): +;; +;; Function `project-current' that returns the current project +;; instance based on the value of the hook `project-find-functions', +;; and several generic functions that act on it. +;; +;; `project-root' must be defined for every project. +;; `project-files' can be overridden for performance purposes. +;; `project-ignores' and `project-external-roots' describe the project +;; files and its relations to external directories. `project-files' +;; should be consistent with `project-ignores'. +;; +;; This list can change in future versions. +;; +;; VC project: +;; +;; Originally conceived as an example implementation, now it's a +;; relatively fast backend that delegates to 'git ls-files' or 'hg +;; status' to list the project's files. It honors the VC ignore +;; files, but supports additions to the list using the user option +;; `project-vc-ignores' (usually through .dir-locals.el). ;; ;; Utils: ;; @@ -50,9 +68,49 @@ ;; ;; Commands: ;; -;; `project-find-file', `project-find-regexp' and -;; `project-or-external-find-regexp' use the current API, and thus -;; will work in any project that has an adapter. +;; `project-prefix-map' contains the full list of commands defined in +;; this package. This map uses the prefix `C-x p' by default. +;; Type `C-x p f' to find file in the current project. +;; Type `C-x p C-h' to see all available commands and bindings. +;; +;; All commands defined in this package are implemented using the +;; public API only. As a result, they will work with any project +;; backend that follows the protocol. +;; +;; Any third-party code that wants to use this package should likewise +;; target the public API. Use any of the built-in commands as the +;; example. +;; +;; How to create a new backend: +;; +;; - Consider whether you really should, or whether there are other +;; ways to reach your goals. If the backend's performance is +;; significantly lower than that of the built-in one, and it's first +;; in the list, it will affect all commands that use it. Unless you +;; are going to be using it only yourself or in special circumstances, +;; you will probably want it to be fast, and it's unlikely to be a +;; trivial endeavor. `project-files' is the method to optimize (the +;; default implementation gets slower the more files the directory +;; has, and the longer the list of ignores is). +;; +;; - Choose the format of the value that represents a project for your +;; backend (we call it project instance). Don't use any of the +;; formats from other backends. The format can be arbitrary, as long +;; as the datatype is something `cl-defmethod' can dispatch on. The +;; value should be stable (when compared with `equal') across +;; invocations, meaning calls to that function from buffers belonging +;; to the same project should return equal values. +;; +;; - Write a new function that will determine the current project +;; based on the directory and add it to `project-find-functions' +;; (which see) using `add-hook'. It is a good idea to depend on the +;; directory only, and not on the current major mode, for example. +;; Because the usual expectation is that all files in the directory +;; belong to the same project (even if some/most of them are ignored). +;; +;; - Define new methods for some or all generic functions for this +;; backend using `cl-defmethod'. A `project-root' method is +;; mandatory, `project-files' is recommended, the rest are optional. ;;; TODO: @@ -91,6 +149,7 @@ ;;; Code: (require 'cl-generic) +(require 'seq) (eval-when-compile (require 'subr-x)) (defgroup project nil @@ -101,30 +160,46 @@ (defvar project-find-functions (list #'project-try-vc) "Special hook to find the project containing a given directory. Each functions on this hook is called in turn with one -argument (the directory) and should return either nil to mean -that it is not applicable, or a project instance.") +argument, the directory in which to look, and should return +either nil to mean that it is not applicable, or a project instance. +The exact form of the project instance is up to each respective +function; the only practical limitation is to use values that +`cl-defmethod' can dispatch on, like a cons cell, or a list, or a +CL struct.") (defvar project-current-inhibit-prompt nil "Non-nil to skip prompting the user in `project-current'.") ;;;###autoload -(defun project-current (&optional maybe-prompt dir) - "Return the project instance in DIR or `default-directory'. -When no project found in DIR, and MAYBE-PROMPT is non-nil, ask -the user for a different project to look in." - (unless dir (setq dir default-directory)) - (let ((pr (project--find-in-directory dir))) +(defun project-current (&optional maybe-prompt directory) + "Return the project instance in DIRECTORY, defaulting to `default-directory'. + +When no project is found in that directory, the result depends on +the value of MAYBE-PROMPT: if it is nil or omitted, return nil, +else ask the user for a directory in which to look for the +project, and if no project is found there, return a \"transient\" +project instance. + +The \"transient\" project instance is a special kind of value +which denotes a project rooted in that directory and includes all +the files under the directory except for those that should be +ignored (per `project-ignores'). + +See the doc string of `project-find-functions' for the general form +of the project instance object." + (unless directory (setq directory default-directory)) + (let ((pr (project--find-in-directory directory))) (cond (pr) ((unless project-current-inhibit-prompt maybe-prompt) - (setq dir (project-prompt-project-dir) - pr (project--find-in-directory dir)))) + (setq directory (project-prompt-project-dir) + pr (project--find-in-directory directory)))) (when maybe-prompt (if pr (project--add-to-project-list-front pr) - (project--remove-from-project-list dir) - (setq pr (cons 'transient dir)))) + (project--remove-from-project-list directory) + (setq pr (cons 'transient directory)))) pr)) (defun project--find-in-directory (dir) @@ -294,11 +369,14 @@ The directory names should be absolute. Used in the VC project backend implementation of `project-external-roots'.") (defun project-try-vc (dir) - (let* ((backend (ignore-errors (vc-responsible-backend dir))) + (let* ((backend + ;; FIXME: This is slow. Cache it. + (ignore-errors (vc-responsible-backend dir))) (root (pcase backend ('Git ;; Don't stop at submodule boundary. + ;; FIXME: Cache for a shorter time. (or (vc-file-getprop dir 'project-git-root) (let ((root (vc-call-backend backend 'root dir))) (vc-file-setprop @@ -497,6 +575,7 @@ DIRS must contain directory names." (defvar project-prefix-map (let ((map (make-sparse-keymap))) (define-key map "f" 'project-find-file) + (define-key map "F" 'project-or-external-find-file) (define-key map "b" 'project-switch-to-buffer) (define-key map "s" 'project-shell) (define-key map "d" 'project-dired) @@ -506,6 +585,7 @@ DIRS must contain directory names." (define-key map "k" 'project-kill-buffers) (define-key map "p" 'project-switch-project) (define-key map "g" 'project-find-regexp) + (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) map) "Keymap for project commands.") @@ -799,11 +879,13 @@ Arguments the same as in `compile'." ;;;###autoload (defun project-switch-to-buffer () - "Switch to another buffer that is related to the current project. -A buffer is related to a project if its `default-directory' -is inside the directory hierarchy of the project's root." + "Switch to another buffer belonging to the current project. +This function prompts for another buffer, offering as candidates +buffers that belong to the same project as the current buffer. +Two buffers belong to the same project if their project instances, +as reported by `project-current' in each buffer, are identical." (interactive) - (let* ((root (project-root (project-current t))) + (let* ((pr (project-current t)) (current-buffer (current-buffer)) (other-buffer (other-buffer current-buffer)) (other-name (buffer-name other-buffer)) @@ -811,10 +893,9 @@ is inside the directory hierarchy of the project's root." (lambda (buffer) ;; BUFFER is an entry (BUF-NAME . BUF-OBJ) of Vbuffer_alist. (and (cdr buffer) - (not (eq (cdr buffer) current-buffer)) - (when-let ((file (buffer-local-value 'default-directory - (cdr buffer)))) - (file-in-directory-p file root)))))) + (equal pr + (with-current-buffer (cdr buffer) + (project-current))))))) (switch-to-buffer (read-buffer "Switch to buffer: " @@ -836,18 +917,19 @@ any of the conditions will not be killed." (defun project--buffer-list (pr) "Return the list of all buffers in project PR." - (let ((root (project-root pr)) - bufs) + (let (bufs) (dolist (buf (buffer-list)) - (let ((filename (or (buffer-file-name buf) - (buffer-local-value 'default-directory buf)))) - (when (and filename (file-in-directory-p filename root)) - (push buf bufs)))) + (when (equal pr + (with-current-buffer buf + (project-current))) + (push buf bufs))) (nreverse bufs))) ;;;###autoload (defun project-kill-buffers () "Kill all live buffers belonging to the current project. +Two buffers belong to the same project if their project instances, +as reported by `project-current' in each buffer, are identical. Certain buffers may be \"spared\", see `project-kill-buffers-ignores'." (interactive) (let ((pr (project-current t)) bufs) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 22248f04402..3af55be4a19 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -34,7 +34,7 @@ ;; Implements Syntax highlighting, Indentation, Movement, Shell ;; interaction, Shell completion, Shell virtualenv support, Shell ;; package support, Shell syntax highlighting, Pdb tracking, Symbol -;; completion, Skeletons, FFAP, Code Check, Eldoc, Imenu. +;; completion, Skeletons, FFAP, Code Check, ElDoc, Imenu. ;; Syntax highlighting: Fontification of code is provided and supports ;; python's triple quoted strings properly. @@ -216,7 +216,7 @@ ;; Code check: Check the current file for errors with `python-check' ;; using the program defined in `python-check-command'. -;; Eldoc: returns documentation for object at point by using the +;; ElDoc: returns documentation for object at point by using the ;; inferior python subprocess to inspect its documentation. As you ;; might guessed you should run `python-shell-send-buffer' from time ;; to time to get better results too. @@ -4474,7 +4474,7 @@ See `python-check-command' for the default." (format python-check-buffer-name command))))) -;;; Eldoc +;;; ElDoc (defcustom python-eldoc-setup-code "def __PYDOC_get_help(obj): @@ -4573,7 +4573,7 @@ returns will be used. If not FORCE-PROCESS is passed what :type 'boolean :version "25.1") -(defun python-eldoc-function () +(defun python-eldoc-function (&rest _ignored) "`eldoc-documentation-function' for Python. For this to work as best as possible you should call `python-shell-send-buffer' from time to time so context in @@ -4591,7 +4591,7 @@ fetching." (with-timeout (python-eldoc-function-timeout (if python-eldoc-function-timeout-permanent (progn - (message "Eldoc echo-area display muted in this buffer, see `python-eldoc-function'") + (message "ElDoc echo-area display muted in this buffer, see `python-eldoc-function'") (setq python-eldoc-get-doc nil)) (message "`python-eldoc-function' timed out, see `python-eldoc-function-timeout'"))) (python-eldoc--get-doc-at-point)))) @@ -5553,14 +5553,16 @@ REPORT-FN is Flymake's callback function." (current-column)))) (^ '(- (1+ (current-indentation)))))) - (if (null eldoc-documentation-function) - ;; Emacs<25 - (set (make-local-variable 'eldoc-documentation-function) - #'python-eldoc-function) - (if (boundp 'eldoc-documentation-functions) - (add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t) - (add-function :before-until (local 'eldoc-documentation-function) - #'python-eldoc-function))) + (with-no-warnings + ;; supress warnings about eldoc-documentation-function being obsolete + (if (null eldoc-documentation-function) + ;; Emacs<25 + (set (make-local-variable 'eldoc-documentation-function) + #'python-eldoc-function) + (if (boundp 'eldoc-documentation-functions) + (add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t) + (add-function :before-until (local 'eldoc-documentation-function) + #'python-eldoc-function)))) (add-to-list 'hs-special-modes-alist diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 6400e1e6cd9..5a469bb9677 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2020.02.23.232634261 +;; Version: 2020.06.27.014326051 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2020-02-23-dddb795-vpo-GNU" +(defconst verilog-mode-version "2020-06-27-0da9923-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -1430,7 +1430,7 @@ See also `verilog-case-fold'." :type 'hook) (defvar verilog-imenu-generic-expression - '((nil "^\\s-*\\(?:m\\(?:odule\\|acromodule\\)\\|p\\(?:rimitive\\|rogram\\|ackage\\)\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 1) + '((nil "^\\s-*\\(?:connectmodule\\|m\\(?:odule\\|acromodule\\)\\|p\\(?:rimitive\\|rogram\\|ackage\\)\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 1) ("*Variables*" "^\\s-*\\(reg\\|wire\\|logic\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3) ("*Classes*" "^\\s-*\\(?:\\(?:virtual\\|interface\\)\\s-+\\)?class\\s-+\\([A-Za-z_][A-Za-z0-9_]+\\)" 1) ("*Tasks*" "^\\s-*\\(?:\\(?:static\\|pure\\|virtual\\|local\\|protected\\)\\s-+\\)*task\\s-+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_:]+\\)" 1) @@ -2515,11 +2515,13 @@ find the errors." (eval-when-compile (verilog-regexp-words '( "begin" + "connectmodule" "else" "end" "endcase" "endclass" "endclocking" + "endconnectmodule" "endgroup" "endfunction" "endmodule" @@ -2562,6 +2564,7 @@ find the errors." "\\(sequence\\)\\|" ; 14 "\\(clocking\\)\\|" ; 15 "\\(property\\)\\|" ; 16 + "\\(connectmodule\\)\\|" ; 17 "\\)\\>\\)")) (defconst verilog-end-block-re (eval-when-compile @@ -2722,6 +2725,7 @@ find the errors." "endclass" "endclocking" "endconfig" + "endconnectmodule" "endfunction" "endgenerate" "endgroup" @@ -2740,7 +2744,7 @@ find the errors." (defconst verilog-declaration-opener (eval-when-compile (verilog-regexp-words - '("module" "begin" "task" "function")))) + '("connectmodule" "module" "begin" "task" "function")))) (defconst verilog-declaration-prefix-re (eval-when-compile @@ -2802,9 +2806,9 @@ find the errors." (defconst verilog-declaration-re-1-no-macro (concat "^" verilog-declaration-re-2-no-macro)) (defconst verilog-defun-re - (eval-when-compile (verilog-regexp-words '("macromodule" "module" "class" "program" "interface" "package" "primitive" "config")))) + (eval-when-compile (verilog-regexp-words '("macromodule" "connectmodule" "module" "class" "program" "interface" "package" "primitive" "config")))) (defconst verilog-end-defun-re - (eval-when-compile (verilog-regexp-words '("endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig")))) + (eval-when-compile (verilog-regexp-words '("endconnectmodule" "endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig")))) (defconst verilog-zero-indent-re (concat verilog-defun-re "\\|" verilog-end-defun-re)) (defconst verilog-inst-comment-re @@ -2836,7 +2840,7 @@ find the errors." "generate" "endgenerate" "initial" "interface" "endinterface" - "module" "macromodule" "endmodule" + "connectmodule" "module" "macromodule" "endconnectmodule" "endmodule" "package" "endpackage" "primitive" "endprimitive" "program" "endprogram" @@ -2904,14 +2908,14 @@ find the errors." (defconst verilog-defun-level-not-generate-re (eval-when-compile (verilog-regexp-words - '( "module" "macromodule" "primitive" "class" "program" + '( "connectmodule" "module" "macromodule" "primitive" "class" "program" "interface" "package" "config")))) (defconst verilog-defun-level-re (eval-when-compile (verilog-regexp-words (append - '( "module" "macromodule" "primitive" "class" "program" + '( "connectmodule" "module" "macromodule" "primitive" "class" "program" "interface" "package" "config") '( "initial" "final" "always" "always_comb" "always_ff" "always_latch" "endtask" "endfunction" ))))) @@ -2926,7 +2930,7 @@ find the errors." (eval-when-compile (verilog-regexp-words '( - "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass" + "endconnectmodule" "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass" )))) (defconst verilog-dpi-import-export-re @@ -2947,7 +2951,7 @@ find the errors." (eval-when-compile (verilog-regexp-words '( - "always" "assign" "always_latch" "always_ff" "always_comb" "constraint" + "always" "assign" "always_latch" "always_ff" "always_comb" "connectmodule" "constraint" "import" "initial" "final" "module" "macromodule" "repeat" "randcase" "while" "if" "for" "forever" "foreach" "else" "parameter" "do" "localparam" "assert" )))) @@ -3065,6 +3069,8 @@ find the errors." "sync_reject_on" "unique0" "until" "until_with" "untyped" "weak" ;; 1800-2012 "implements" "interconnect" "nettype" "soft" + ;; AMS + "connectmodule" "endconnectmodule" )) "List of Verilog keywords.") @@ -3211,7 +3217,7 @@ See also `verilog-font-lock-extra-types'.") "atan2" "atanh" "branch" "ceil" "connect" "connectmodule" "connectrules" "continuous" "cos" "cosh" "ddt" "ddt_nature" "ddx" "discipline" "discrete" "domain" "driver_update" - "endconnectrules" "enddiscipline" "endnature" "endparamset" + "endconnectmodule" "endconnectrules" "enddiscipline" "endnature" "endparamset" "exclude" "exp" "final_step" "flicker_noise" "floor" "flow" "from" "ground" "hypot" "idt" "idt_nature" "idtmod" "inf" "initial_step" "laplace_nd" "laplace_np" "laplace_zd" @@ -3290,9 +3296,9 @@ See also `verilog-font-lock-extra-types'.") (list ;; Fontify module definitions (list - "\\<\\(\\(macro\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)" + "\\<\\(\\(macro\\|connect\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)" '(1 font-lock-keyword-face) - '(3 font-lock-function-name-face 'prepend)) + '(3 font-lock-function-name-face prepend)) ;; Fontify function definitions (list (concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" ) @@ -3302,7 +3308,16 @@ See also `verilog-font-lock-extra-types'.") (1 font-lock-keyword-face) (2 font-lock-constant-face append)) '("\\<function\\>\\s-+\\(\\sw+\\)" - 1 'font-lock-constant-face append)))) + 1 'font-lock-constant-face append) + ;; Fontify variable names in declarations + (list ;; Implemented as an anchored-matcher + (concat verilog-declaration-re + " *\\(" verilog-range-re "\\)?") + (list ;; anchored-highlighter + (concat "\\_<\\(" verilog-symbol-re "\\)" + " *\\(" verilog-range-re "\\)?*") + nil nil '(1 font-lock-variable-name-face)))))) + (setq verilog-font-lock-keywords-2 (append verilog-font-lock-keywords-1 @@ -3608,7 +3623,7 @@ Use filename, if current buffer being edited shorten to just buffer name." (setq found 't)))))) ((looking-at verilog-end-block-re) (verilog-leap-to-head)) - ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)") + ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)\\|\\(\\<endconnectmodule\\>\\)") (cond ((match-end 1) (verilog-re-search-backward "\\<\\(macro\\)?module\\>" nil 'move)) @@ -3622,6 +3637,8 @@ Use filename, if current buffer being edited shorten to just buffer name." (verilog-re-search-backward "\\<interface\\>" nil 'move)) ((match-end 6) (verilog-re-search-backward "\\<package\\>" nil 'move)) + ((match-end 7) + (verilog-re-search-backward "\\<connectmodule\\>" nil 'move)) (t (goto-char st) (backward-sexp 1)))) @@ -3747,7 +3764,8 @@ Use filename, if current buffer being edited shorten to just buffer name." "\\(\\<class\\>\\)\\|" "\\(\\<program\\>\\)\\|" "\\(\\<interface\\>\\)\\|" - "\\(\\<package\\>\\)")) + "\\(\\<package\\>\\)\\|" + "\\(\\<connectmodule\\>\\)")) (cond ((match-end 1) (verilog-re-search-forward "\\<endmodule\\>" nil 'move)) @@ -3761,6 +3779,8 @@ Use filename, if current buffer being edited shorten to just buffer name." (verilog-re-search-forward "\\<endinterface\\>" nil 'move)) ((match-end 6) (verilog-re-search-forward "\\<endpackage\\>" nil 'move)) + ((match-end 7) + (verilog-re-search-forward "\\<endconnectmodule\\>" nil 'move)) (t (goto-char st) (if (= (following-char) ?\) ) @@ -4568,13 +4588,13 @@ More specifically, point @ in the line foo : @ begin" (let ((nest 1)) (while t (verilog-re-search-backward - (concat "\\(\\<module\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|" + (concat "\\(\\<module\\>\\)\\|\\(\\<connectmodule\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|" "\\(\\<endcase\\>\\)\\>") nil 'move) (cond - ((match-end 3) + ((match-end 4) (setq nest (1+ nest))) - ((match-end 2) + ((match-end 3) (if (= nest 1) (throw 'found 1)) (setq nest (1- nest))) @@ -4609,13 +4629,15 @@ More specifically, after a generate and before an endgenerate." (while (and (/= nest 0) (verilog-re-search-backward - "\\<\\(module\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\>" nil 'move) + "\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\>" nil 'move) (cond ((match-end 1) ; module - we have crawled out (throw 'done 1)) - ((match-end 2) ; generate + ((match-end 2) ; connectmodule - we have crawled out + (throw 'done 1)) + ((match-end 3) ; generate (setq nest (1- nest))) - ((match-end 3) ; endgenerate + ((match-end 4) ; endgenerate (setq nest (1+ nest)))))))) (= nest 0) )) ; return nest @@ -5078,6 +5100,8 @@ primitive or interface named NAME." (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>")) ((match-end 16) ; of verilog-end-block-ordered-re (setq reg "\\(\\<property\\>\\)\\|\\<endproperty\\>")) + ((match-end 17) ; of verilog-end-block-ordered-re + (setq reg "\\(\\<connectmodule\\>\\)\\|\\<endconnectmodule\\>")) (t (error "Problem in verilog-set-auto-endcomments"))) (let (b e) @@ -5103,7 +5127,7 @@ primitive or interface named NAME." (setq string (buffer-substring b e))) (t (ding 't) - (setq string "unmatched end(function|task|module|primitive|interface|package|class|clocking)"))))) + (setq string "unmatched end(function|task|module|connectmodule|primitive|interface|package|class|clocking)"))))) (end-of-line) (insert (concat " // " string ))) )))))))))) @@ -5574,7 +5598,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (case-fold-search nil) (par 0) (begin (looking-at "[ \t]*begin\\>")) - (lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)" nil t))) + (lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<\\(connect\\)?module\\>\\)" nil t))) (structres nil) (type (catch 'nesting ;; Keep working backwards until we can figure out @@ -7127,7 +7151,7 @@ BASEIND is the base indent to offset everything." (let ((pos (point-marker)) (lim (save-excursion ;; (verilog-re-search-backward verilog-declaration-opener nil 'move) - (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)\\|\\(\\<task\\>\\)" nil 'move) + (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<\\(connect\\)?module\\>\\)\\|\\(\\<task\\>\\)" nil 'move) (point))) (ind) (val) @@ -7286,7 +7310,7 @@ it displays a list of all possible completions.") \(integer, real, reg...)") (defvar verilog-cpp-keywords - '("module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else" + '("connectmodule" "module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else" "endif") "Keywords to complete when at first word of a line in declarative scope. \(initial, always, begin, assign...) @@ -7297,7 +7321,7 @@ will be completed at runtime and should not be added to this list.") (append '( "always" "always_comb" "always_ff" "always_latch" "assign" - "begin" "end" "generate" "endgenerate" "module" "endmodule" + "begin" "end" "connectmodule" "endconnectmodule" "generate" "endgenerate" "module" "endmodule" "specify" "endspecify" "function" "endfunction" "initial" "final" "task" "endtask" "primitive" "endprimitive" ) @@ -7394,9 +7418,9 @@ TYPE is `module', `tf' for task or function, or t if unknown." (if (string= verilog-str "") (setq verilog-str "[a-zA-Z_]")) (let ((verilog-str (concat (cond - ((eq type 'module) "\\<\\(module\\)\\s +") + ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +") ((eq type 'tf) "\\<\\(task\\|function\\)\\s +") - (t "\\<\\(task\\|function\\|module\\)\\s +")) + (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +")) "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>")) match) @@ -7738,7 +7762,7 @@ If search fails, other files are checked based on (first 1) (prevpos (point-min)) (final-context-start (make-marker)) - (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)")) + (regexp "\\(\\(connect\\)?module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)")) (with-output-to-temp-buffer "*Occur*" (save-excursion (message "Searching for %s ..." regexp) @@ -8459,7 +8483,8 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." (let ((olist)) (save-excursion ;; /*AUTOPUNT("parameter", "parameter")*/ - (backward-sexp 1) + (when (not (eq (char-before) ?\*)) ; Not .* + (backward-sexp 1)) (while (looking-at "(?\\s *\"\\([^\"]*\\)\"\\s *,?") (setq olist (cons (match-string-no-properties 1) olist)) (goto-char (match-end 0)))) @@ -9909,7 +9934,7 @@ Allows version control to check out the file if need be." (while (and ;; It may be tempting to look for verilog-defun-re, ;; don't, it slows things down a lot! - (verilog-re-search-forward-quick "\\<\\(module\\|interface\\|program\\)\\>" nil t) + (verilog-re-search-forward-quick "\\<\\(connectmodule\\|module\\|interface\\|program\\)\\>" nil t) (setq type (match-string-no-properties 0)) (verilog-re-search-forward-quick "[(;]" nil t)) (if (equal module (verilog-read-module-name)) @@ -10937,9 +10962,9 @@ shown) will make this into: ;; Presume one module per file. (save-excursion (goto-char (point-min)) - (while (verilog-re-search-forward-quick "\\<module\\>" nil t) + (while (verilog-re-search-forward-quick "\\<\\(connect\\)?module\\>" nil t) (let ((endmodp (save-excursion - (verilog-re-search-forward-quick "\\<endmodule\\>" nil t) + (verilog-re-search-forward-quick "\\<end\\(connect\\)?module\\>" nil t) (point)))) ;; See if there's already a comment .. inside a comment so not verilog-re-search (when (not (re-search-forward "/\\*AUTOARG\\*/" endmodp t)) @@ -11583,6 +11608,9 @@ Replace the pin connections to an instantiation or interface declaration with ones automatically derived from the module or interface header of the instantiated item. +You may also provide an optional regular expression, in which +case only I/O matching the regular expression will be included. + If `verilog-auto-star-expand' is set, also expand SystemVerilog .* ports, and delete them before saving unless `verilog-auto-star-save' is set. See `verilog-auto-star' for more information. @@ -11901,7 +11929,9 @@ For more information see the \\[verilog-faq] and forums at URL `https://www.veripool.org'." (save-excursion ;; Find beginning - (let* ((pt (point)) + (let* ((params (verilog-read-auto-params 0 1)) + (regexp (nth 0 params)) + (pt (point)) (for-star (save-excursion (backward-char 2) (looking-at "\\.\\*"))) (indent-pt (save-excursion (verilog-backward-open-paren) (1+ (current-column)))) @@ -11946,6 +11976,8 @@ For more information see the \\[verilog-faq] and forums at URL (verilog-decls-get-vars submoddecls) skip-pins))) (vl-dir "interfaced")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when (and sig-list verilog-auto-inst-interfaced-ports) ;; Note these are searched for in verilog-read-sub-decls. @@ -11956,6 +11988,8 @@ For more information see the \\[verilog-faq] and forums at URL (verilog-decls-get-interfaces submoddecls) skip-pins)) (vl-dir "interface")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when sig-list ;; Note these are searched for in verilog-read-sub-decls. (verilog-auto-inst-port-list "// Interfaces\n" @@ -11965,6 +11999,8 @@ For more information see the \\[verilog-faq] and forums at URL (verilog-decls-get-outputs submoddecls) skip-pins)) (vl-dir "output")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when sig-list (verilog-auto-inst-port-list "// Outputs\n" sig-list indent-pt moddecls @@ -11973,6 +12009,8 @@ For more information see the \\[verilog-faq] and forums at URL (verilog-decls-get-inouts submoddecls) skip-pins)) (vl-dir "inout")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when sig-list (verilog-auto-inst-port-list "// Inouts\n" sig-list indent-pt moddecls @@ -11981,6 +12019,8 @@ For more information see the \\[verilog-faq] and forums at URL (verilog-decls-get-inputs submoddecls) skip-pins)) (vl-dir "input")) + (when regexp + (setq sig-list (verilog-signals-matching-regexp sig-list regexp))) (when sig-list (verilog-auto-inst-port-list "// Inputs\n" sig-list indent-pt moddecls diff --git a/lisp/shell.el b/lisp/shell.el index 1e2679f7235..dc528412a62 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -184,16 +184,13 @@ shell buffer. The value may depend on the operating system or shell." shell-environment-variable-completion shell-command-completion shell-c-a-p-replace-by-expanded-directory + pcomplete-completions-at-point shell-filename-completion - comint-filename-completion - ;; Put `pcomplete-completions-at-point' last so that other - ;; functions can run before it does, see bug#34330. - pcomplete-completions-at-point) + comint-filename-completion) "List of functions called to perform completion. This variable is used to initialize `comint-dynamic-complete-functions' in the shell buffer." :type '(repeat function) - :version "27.1" :group 'shell) (defcustom shell-command-regexp "[^;&|\n]+" diff --git a/lisp/simple.el b/lisp/simple.el index a28d10fd4a5..2f92238e640 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1622,8 +1622,11 @@ display the result of expression evaluation." (let ((minibuffer-completing-symbol t)) (minibuffer-with-setup-hook (lambda () - ;; FIXME: call emacs-lisp-mode (see also - ;; `eldoc--eval-expression-setup')? + ;; FIXME: instead of just applying the syntax table, maybe + ;; use a special major mode tailored to reading Lisp + ;; expressions from the minibuffer? (`emacs-lisp-mode' + ;; doesn't preserve the necessary keybindings.) + (set-syntax-table emacs-lisp-mode-syntax-table) (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil t) (run-hooks 'eval-expression-minibuffer-setup-hook)) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 04f4bca166c..cee88cb4275 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1581,7 +1581,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (display-buffer-in-tab buffer (append alist '((inhibit-same-window . nil)))) (selected-window)) - 'tab))) + 'tab)) + nil "[other-tab]") (message "Display next command buffer in a new tab...")) (define-key tab-prefix-map "2" 'tab-new) diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el index 1ae07c0a304..54e20779bdc 100644 --- a/lisp/textmodes/mhtml-mode.el +++ b/lisp/textmodes/mhtml-mode.el @@ -73,7 +73,9 @@ code(); (defconst mhtml--crucial-variable-prefix (regexp-opt '("comment-" "uncomment-" "electric-indent-" - "smie-" "forward-sexp-function" "completion-" "major-mode")) + "smie-" "forward-sexp-function" "completion-" "major-mode" + "adaptive-fill-" "fill-" "normal-auto-fill-function" + "paragraph-")) "Regexp matching the prefix of \"crucial\" buffer-locals we want to capture.") (defconst mhtml--variable-prefix @@ -255,17 +257,14 @@ This is used by `mhtml--pre-command'.") sgml-syntax-propertize-rules)) (defun mhtml-syntax-propertize (start end) - ;; First remove our special settings from the affected text. They - ;; will be re-applied as needed. - (remove-list-of-text-properties start end - '(syntax-table local-map mhtml-submode)) - (goto-char start) - ;; Be sure to look back one character, because START won't yet have - ;; been propertized. - (unless (bobp) - (let ((submode (get-text-property (1- (point)) 'mhtml-submode))) - (if submode - (mhtml--syntax-propertize-submode submode end)))) + (let ((submode (get-text-property start 'mhtml-submode))) + ;; First remove our special settings from the affected text. They + ;; will be re-applied as needed. + (remove-list-of-text-properties start end + '(syntax-table local-map mhtml-submode)) + (goto-char start) + (if submode + (mhtml--syntax-propertize-submode submode end))) (sgml-syntax-propertize (point) end mhtml--syntax-propertize)) (defun mhtml-indent-line () @@ -333,6 +332,18 @@ the rules from `css-mode'." ;: Hack (js--update-quick-match-re) + ;; Setup the appropriate js-mode value of auto-fill-function. + (setf (mhtml--submode-crucial-captured-locals mhtml--js-submode) + (push (cons 'auto-fill-function + (if (and (boundp 'auto-fill-function) auto-fill-function) + #'js-do-auto-fill + nil)) + (mhtml--submode-crucial-captured-locals mhtml--js-submode))) + + ;; This mode might be using CC Mode's filling functionality. + (c-foreign-init-lit-pos-cache) + (add-hook 'before-change-functions #'c-foreign-truncate-lit-pos-cache nil t) + ;; This is sort of a prog-mode as well as a text mode. (run-hooks 'prog-mode-hook)) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 669c24571f9..8532da1d1fb 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -702,15 +702,7 @@ should be shown to the user." ;; Treat everything like '300' nil)) (when redirect-uri - ;; Clean off any whitespace and/or <...> cruft. - (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - (if (string-match "^<\\(.*\\)>$" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - - ;; Some stupid sites (like sourceforge) send a - ;; non-fully-qualified URL (ie: /), which royally confuses - ;; the URL library. + ;; Handle relative redirect URIs. (if (not (string-match url-nonrelative-link redirect-uri)) ;; Be careful to use the real target URL, otherwise we may ;; compute the redirection relative to the URL of the proxy. @@ -1404,13 +1396,22 @@ The return value of this function is the retrieval buffer." (defun url-https-proxy-connect (connection) (setq url-http-after-change-function 'url-https-proxy-after-change-function) - (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n" - "Host: %s\r\n" - "\r\n") - (url-host url-current-object) - (or (url-port url-current-object) - url-https-default-port) - (url-host url-current-object)))) + (process-send-string + connection + (format + (concat "CONNECT %s:%d HTTP/1.1\r\n" + "Host: %s\r\n" + (let ((proxy-auth (let ((url-basic-auth-storage + 'url-http-proxy-basic-auth-storage)) + (url-get-authentication url-http-proxy nil + 'any nil)))) + (and proxy-auth + (concat "Proxy-Authorization: " proxy-auth "\r\n"))) + "\r\n") + (url-host url-current-object) + (or (url-port url-current-object) + url-https-default-port) + (url-host url-current-object)))) (defun url-https-proxy-after-change-function (_st _nd _length) (let* ((process-buffer (current-buffer)) diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index ff18cf1fe40..46cdff0f724 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -123,17 +123,24 @@ The variable `url-queue-timeout' sets a timeout." (setq url-queue-progress-timer nil)))) (defun url-queue-callback-function (status job) - (setq url-queue (delq job url-queue)) - (when (and (eq (car status) :error) - (eq (cadr (cadr status)) 'connection-failed)) - ;; If we get a connection error, then flush all other jobs from - ;; the host from the queue. This particularly makes sense if the - ;; error really is a DNS resolver issue, which happens - ;; synchronously and totally halts Emacs. - (url-queue-remove-jobs-from-host - (plist-get (nthcdr 3 (cadr status)) :host))) - (url-queue-run-queue) - (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))) + (let ((buffer (current-buffer))) + (setq url-queue (delq job url-queue)) + (when (and (eq (car status) :error) + (eq (cadr (cadr status)) 'connection-failed)) + ;; If we get a connection error, then flush all other jobs from + ;; the host from the queue. This particularly makes sense if the + ;; error really is a DNS resolver issue, which happens + ;; synchronously and totally halts Emacs. + (url-queue-remove-jobs-from-host + (plist-get (nthcdr 3 (cadr status)) :host))) + (url-queue-run-queue) + ;; Somehow something deep in the bowels in the URL library may + ;; have killed off the current buffer. So check that it's still + ;; alive before doing anything, and if not, just create a dummy + ;; buffer and do the callback anyway. + (unless (buffer-live-p buffer) + (set-buffer (generate-new-buffer " *temp*"))) + (apply (url-queue-callback job) (cons status (url-queue-cbargs job))))) (defun url-queue-remove-jobs-from-host (host) (let ((jobs nil)) diff --git a/lisp/url/url.el b/lisp/url/url.el index 12a8a9c2e21..321e79c019f 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -238,7 +238,8 @@ how long to wait for a response before giving up." (let ((retrieval-done nil) (start-time (current-time)) (url-asynchronous nil) - (asynch-buffer nil)) + (asynch-buffer nil) + (timed-out nil)) (setq asynch-buffer (url-retrieve url (lambda (&rest ignored) (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer)) @@ -261,7 +262,9 @@ how long to wait for a response before giving up." ;; process output. (while (and (not retrieval-done) (or (not timeout) - (time-less-p (time-since start-time) timeout))) + (not (setq timed-out + (time-less-p timeout + (time-since start-time)))))) (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" retrieval-done asynch-buffer) @@ -300,8 +303,16 @@ how long to wait for a response before giving up." (when quit-flag (delete-process proc)) (setq proc (and (not quit-flag) - (get-buffer-process asynch-buffer))))))) - asynch-buffer))) + (get-buffer-process asynch-buffer)))))) + ;; On timeouts, make sure we kill any pending processes. + ;; There may be more than one if we had a redirect. + (when timed-out + (when (process-live-p proc) + (delete-process proc)) + (when-let ((aproc (get-buffer-process asynch-buffer))) + (when (process-live-p aproc) + (delete-process aproc)))))) + asynch-buffer)) ;; url-mm-callback called from url-mm, which requires mm-decode. (declare-function mm-dissect-buffer "mm-decode" diff --git a/lisp/windmove.el b/lisp/windmove.el index 341c739d924..65579600640 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -491,8 +491,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (cons window type))) (lambda (old-window new-window) (when (window-live-p (if no-select old-window new-window)) - (select-window (if no-select old-window new-window)))))) - (message "[display-%s]" dir)) + (select-window (if no-select old-window new-window)))) + (format "[display-%s]" dir)))) ;;;###autoload (defun windmove-display-left (&optional arg) diff --git a/lisp/window.el b/lisp/window.el index 675aff041b1..f20940fa0ea 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4021,7 +4021,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (setq type 'window) (setq window (display-buffer-use-some-window buffer alist) type 'reuse)) - (cons window type)))) + (cons window type))) + nil "[other-window]") (message "Display next command buffer in a new window...")) (defun same-window-prefix () @@ -4039,7 +4040,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (cons (or (display-buffer-same-window buffer alist) (display-buffer-use-some-window buffer alist)) - 'reuse))) + 'reuse)) + nil "[same-window]") (message "Display next command buffer in the same window...")) ;; This should probably return non-nil when the selected window is part @@ -8616,14 +8618,16 @@ documentation for additional customization information." (list (read-buffer-to-switch "Switch to buffer in other frame: "))) (pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord)) -(defun display-buffer-override-next-command (pre-function &optional post-function) +(defun display-buffer-override-next-command (pre-function &optional post-function echo) "Set `display-buffer-overriding-action' for the next command. `pre-function' is called to prepare the window where the buffer should be displayed. This function takes two arguments `buffer' and `alist', and should return a cons with the displayed window and its type. See the meaning of these values in `window--display-buffer'. Optional `post-function' is called after the buffer is displayed in the -window; the function takes two arguments: an old and new window." +window; the function takes two arguments: an old and new window. +Optional string argument `echo' can be used to add a prefix to the +command echo keystrokes that should describe the current prefix state." (let* ((old-window (or (minibuffer-selected-window) (selected-window))) (new-window nil) (minibuffer-depth (minibuffer-depth)) @@ -8641,11 +8645,13 @@ window; the function takes two arguments: an old and new window." (setq post-function nil) new-window)))) (command this-command) + (echofun (when echo (lambda () echo))) (exitfun (lambda () (setcar display-buffer-overriding-action (delq action (car display-buffer-overriding-action))) (remove-hook 'post-command-hook clearfun) + (remove-hook 'prefix-command-echo-keystrokes-functions echofun) (when (functionp post-function) (funcall post-function old-window new-window))))) (fset clearfun @@ -8661,6 +8667,8 @@ window; the function takes two arguments: an old and new window." ;; Reset display-buffer-overriding-action ;; after the next command finishes (add-hook 'post-command-hook clearfun) + (when echofun + (add-hook 'prefix-command-echo-keystrokes-functions echofun)) (push action (car display-buffer-overriding-action)))) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 775dddf8ef6..aed6c09122c 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -92,6 +92,9 @@ Interactively, URL defaults to the string looking like a url around point." (or (featurep 'xwidget-internal) (user-error "Your Emacs was not compiled with xwidgets support")) (when (stringp url) + ;; If it's a "naked url", just try adding https: to it. + (unless (string-match "\\`[A-Za-z]+:" url) + (setq url (concat "https://" url))) (if new-session (xwidget-webkit-new-session url) (xwidget-webkit-goto-url url)))) diff --git a/m4/dup2.m4 b/m4/dup2.m4 index 21b1ecc26b8..462bfd0e526 100644 --- a/m4/dup2.m4 +++ b/m4/dup2.m4 @@ -1,4 +1,4 @@ -#serial 25 +#serial 26 dnl Copyright (C) 2002, 2005, 2007, 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -8,107 +8,94 @@ AC_DEFUN([gl_FUNC_DUP2], [ AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) AC_REQUIRE([AC_CANONICAL_HOST]) - m4_ifdef([gl_FUNC_DUP2_OBSOLETE], [ - AC_CHECK_FUNCS_ONCE([dup2]) - if test $ac_cv_func_dup2 = no; then - HAVE_DUP2=0 - fi - ], [ - AC_DEFINE([HAVE_DUP2], [1], [Define to 1 if you have the 'dup2' function.]) - ]) - if test $HAVE_DUP2 = 1; then - AC_CACHE_CHECK([whether dup2 works], [gl_cv_func_dup2_works], - [AC_RUN_IFELSE([ - AC_LANG_PROGRAM( - [[#include <errno.h> - #include <fcntl.h> - #include <limits.h> - #include <sys/resource.h> - #include <unistd.h> - #ifndef RLIM_SAVED_CUR - # define RLIM_SAVED_CUR RLIM_INFINITY - #endif - #ifndef RLIM_SAVED_MAX - # define RLIM_SAVED_MAX RLIM_INFINITY - #endif - ]], - [[int result = 0; - int bad_fd = INT_MAX; - struct rlimit rlim; - if (getrlimit (RLIMIT_NOFILE, &rlim) == 0 - && 0 <= rlim.rlim_cur && rlim.rlim_cur <= INT_MAX - && rlim.rlim_cur != RLIM_INFINITY - && rlim.rlim_cur != RLIM_SAVED_MAX - && rlim.rlim_cur != RLIM_SAVED_CUR) - bad_fd = rlim.rlim_cur; - #ifdef FD_CLOEXEC - if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1) - result |= 1; - #endif - if (dup2 (1, 1) != 1) - result |= 2; - #ifdef FD_CLOEXEC - if (fcntl (1, F_GETFD) != FD_CLOEXEC) - result |= 4; - #endif - close (0); - if (dup2 (0, 0) != -1) - result |= 8; - /* Many gnulib modules require POSIX conformance of EBADF. */ - if (dup2 (2, bad_fd) == -1 && errno != EBADF) - result |= 16; - /* Flush out some cygwin core dumps. */ - if (dup2 (2, -1) != -1 || errno != EBADF) - result |= 32; - dup2 (2, 255); - dup2 (2, 256); - /* On OS/2 kLIBC, dup2() does not work on a directory fd. */ - { - int fd = open (".", O_RDONLY); - if (fd == -1) - result |= 64; - else if (dup2 (fd, fd + 1) == -1) - result |= 128; - - close (fd); - } - return result;]]) - ], - [gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no], - [case "$host_os" in - mingw*) # on this platform, dup2 always returns 0 for success - gl_cv_func_dup2_works="guessing no" ;; - cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0 - gl_cv_func_dup2_works="guessing no" ;; - aix* | freebsd*) - # on AIX 7.1 and FreeBSD 6.1, dup2 (1,toobig) gives EMFILE, - # not EBADF. - gl_cv_func_dup2_works="guessing no" ;; - haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC. - gl_cv_func_dup2_works="guessing no" ;; - *-android*) # implemented using dup3(), which fails if oldfd == newfd - gl_cv_func_dup2_works="guessing no" ;; - os2*) # on OS/2 kLIBC, dup2() does not work on a directory fd. - gl_cv_func_dup2_works="guessing no" ;; - *) gl_cv_func_dup2_works="guessing yes" ;; - esac]) - ]) - case "$gl_cv_func_dup2_works" in - *yes) ;; - *) - REPLACE_DUP2=1 - AC_CHECK_FUNCS([setdtablesize]) - ;; - esac - fi + AC_CACHE_CHECK([whether dup2 works], [gl_cv_func_dup2_works], + [AC_RUN_IFELSE([ + AC_LANG_PROGRAM( + [[#include <errno.h> + #include <fcntl.h> + #include <limits.h> + #include <sys/resource.h> + #include <unistd.h> + #ifndef RLIM_SAVED_CUR + # define RLIM_SAVED_CUR RLIM_INFINITY + #endif + #ifndef RLIM_SAVED_MAX + # define RLIM_SAVED_MAX RLIM_INFINITY + #endif + ]], + [[int result = 0; + int bad_fd = INT_MAX; + struct rlimit rlim; + if (getrlimit (RLIMIT_NOFILE, &rlim) == 0 + && 0 <= rlim.rlim_cur && rlim.rlim_cur <= INT_MAX + && rlim.rlim_cur != RLIM_INFINITY + && rlim.rlim_cur != RLIM_SAVED_MAX + && rlim.rlim_cur != RLIM_SAVED_CUR) + bad_fd = rlim.rlim_cur; + #ifdef FD_CLOEXEC + if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1) + result |= 1; + #endif + if (dup2 (1, 1) != 1) + result |= 2; + #ifdef FD_CLOEXEC + if (fcntl (1, F_GETFD) != FD_CLOEXEC) + result |= 4; + #endif + close (0); + if (dup2 (0, 0) != -1) + result |= 8; + /* Many gnulib modules require POSIX conformance of EBADF. */ + if (dup2 (2, bad_fd) == -1 && errno != EBADF) + result |= 16; + /* Flush out some cygwin core dumps. */ + if (dup2 (2, -1) != -1 || errno != EBADF) + result |= 32; + dup2 (2, 255); + dup2 (2, 256); + /* On OS/2 kLIBC, dup2() does not work on a directory fd. */ + { + int fd = open (".", O_RDONLY); + if (fd == -1) + result |= 64; + else if (dup2 (fd, fd + 1) == -1) + result |= 128; + close (fd); + } + return result;]]) + ], + [gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no], + [case "$host_os" in + mingw*) # on this platform, dup2 always returns 0 for success + gl_cv_func_dup2_works="guessing no" ;; + cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0 + gl_cv_func_dup2_works="guessing no" ;; + aix* | freebsd*) + # on AIX 7.1 and FreeBSD 6.1, dup2 (1,toobig) gives EMFILE, + # not EBADF. + gl_cv_func_dup2_works="guessing no" ;; + haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC. + gl_cv_func_dup2_works="guessing no" ;; + *-android*) # implemented using dup3(), which fails if oldfd == newfd + gl_cv_func_dup2_works="guessing no" ;; + os2*) # on OS/2 kLIBC, dup2() does not work on a directory fd. + gl_cv_func_dup2_works="guessing no" ;; + *) gl_cv_func_dup2_works="guessing yes" ;; + esac]) + ]) + case "$gl_cv_func_dup2_works" in + *yes) ;; + *) + REPLACE_DUP2=1 + AC_CHECK_FUNCS([setdtablesize]) + ;; + esac dnl Replace dup2() for supporting the gnulib-defined fchdir() function, dnl to keep fchdir's bookkeeping up-to-date. m4_ifdef([gl_FUNC_FCHDIR], [ gl_TEST_FCHDIR if test $HAVE_FCHDIR = 0; then - if test $HAVE_DUP2 = 1; then - REPLACE_DUP2=1 - fi + REPLACE_DUP2=1 fi ]) ]) diff --git a/m4/getrandom.m4 b/m4/getrandom.m4 index 2a0034bf76c..424c2fad3e3 100644 --- a/m4/getrandom.m4 +++ b/m4/getrandom.m4 @@ -1,4 +1,4 @@ -# getrandom.m4 serial 6 +# getrandom.m4 serial 7 dnl Copyright 2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -36,7 +36,9 @@ AC_DEFUN([gl_FUNC_GETRANDOM], case "$host_os" in mingw*) - AC_CHECK_HEADERS([bcrypt.h]) + AC_CHECK_HEADERS([bcrypt.h], [], [], + [[#include <windows.h> + ]]) AC_CACHE_CHECK([whether the bcrypt library is guaranteed to be present], [gl_cv_lib_assume_bcrypt], [AC_COMPILE_IFELSE( diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 5c92a0768a4..f577a6fa741 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -118,6 +118,7 @@ AC_DEFUN([gl_EARLY], AC_REQUIRE([AC_SYS_LARGEFILE]) # Code from module lchmod: # Code from module libc-config: + # Code from module libgmp: # Code from module limits-h: # Code from module localtime-buffer: # Code from module lstat: @@ -240,7 +241,7 @@ AC_DEFUN([gl_INIT], gl_DIRENT_H gl_DOUBLE_SLASH_ROOT gl_FUNC_DUP2 - if test $HAVE_DUP2 = 0 || test $REPLACE_DUP2 = 1; then + if test $REPLACE_DUP2 = 1; then AC_LIBOBJ([dup2]) gl_PREREQ_DUP2 fi @@ -345,6 +346,10 @@ AC_DEFUN([gl_INIT], gl_INTTYPES_INCOMPLETE AC_REQUIRE([gl_LARGEFILE]) gl___INLINE + gl_LIBGMP + if test -n "$GMP_H"; then + AC_LIBOBJ([mini-gmp-gnulib]) + fi gl_LIMITS_H gl_FUNC_LSTAT if test $REPLACE_LSTAT = 1; then @@ -465,6 +470,7 @@ AC_DEFUN([gl_INIT], gl_SYS_TYPES_H AC_PROG_MKDIR_P gl_FUNC_GEN_TEMPNAME + gl_MODULE_INDICATOR([tempname]) gl_HEADER_TIME_H gl_TIME_R if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then @@ -1034,6 +1040,9 @@ AC_DEFUN([gl_FILE_LIST], [ lib/memmem.c lib/mempcpy.c lib/memrchr.c + lib/mini-gmp-gnulib.c + lib/mini-gmp.c + lib/mini-gmp.h lib/minmax.h lib/mkostemp.c lib/mktime-internal.h @@ -1165,6 +1174,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/inttypes.m4 m4/largefile.m4 m4/lchmod.m4 + m4/libgmp.m4 m4/limits-h.m4 m4/localtime-buffer.m4 m4/lstat.m4 diff --git a/m4/lchmod.m4 b/m4/lchmod.m4 index b9e8a97cb31..a86a304f5f1 100644 --- a/m4/lchmod.m4 +++ b/m4/lchmod.m4 @@ -1,4 +1,4 @@ -#serial 7 +#serial 8 dnl Copyright (C) 2005-2006, 2008-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -26,6 +26,5 @@ AC_DEFUN([gl_FUNC_LCHMOD], # Prerequisites of lib/lchmod.c. AC_DEFUN([gl_PREREQ_LCHMOD], [ - AC_REQUIRE([AC_C_INLINE]) : ]) diff --git a/m4/libgmp.m4 b/m4/libgmp.m4 new file mode 100644 index 00000000000..b569bb73462 --- /dev/null +++ b/m4/libgmp.m4 @@ -0,0 +1,44 @@ +# Configure the GMP library or a replacement. + +dnl Copyright 2020 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_LIBGMP], +[ + AC_ARG_WITH([libgmp], + [AS_HELP_STRING([--without-libgmp], + [do not use the GNU Multiple Precision (GMP) library; + this is the default on systems lacking libgmp.])]) + + AC_CHECK_HEADERS_ONCE([gmp.h]) + GMP_H=gmp.h + LIB_GMP= + + case $with_libgmp in + no) ;; + yes) GMP_H= LIB_GMP=-lgmp;; + *) if test "$ac_cv_header_gmp_h" = yes; then + gl_saved_LIBS=$LIBS + AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) + LIBS=$gl_saved_LIBS + case $ac_cv_search___gmpz_roinit_n in + 'none needed') + GMP_H=;; + -*) + GMP_H= LIB_GMP=$ac_cv_search___gmpz_roinit_n;; + esac + fi;; + esac + + if test -z "$GMP_H"; then + AC_DEFINE([HAVE_GMP], 1, + [Define to 1 if you have the GMP library instead of just the + mini-gmp replacement.]) + fi + + AC_SUBST([LIB_GMP]) + AC_SUBST([GMP_H]) + AM_CONDITIONAL([GL_GENERATE_GMP_H], [test -n "$GMP_H"]) +]) diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 719bafb2909..d18da048d9e 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 19 +# manywarnings.m4 serial 20 dnl Copyright (C) 2008-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -21,7 +21,7 @@ AC_DEFUN([gl_MANYWARN_COMPLEMENT], *" $gl_warn_item "*) ;; *) - gl_warn_set="$gl_warn_set $gl_warn_item" + gl_AS_VAR_APPEND([gl_warn_set], [" $gl_warn_item"]) ;; esac done @@ -49,12 +49,12 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], AC_REQUIRE([AC_PROG_CC]) if test -n "$GCC"; then - dnl Check if -W -Werror -Wno-missing-field-initializers is supported + dnl Check if -Wextra -Werror -Wno-missing-field-initializers is supported dnl with the current $CC $CFLAGS $CPPFLAGS. AC_CACHE_CHECK([whether -Wno-missing-field-initializers is supported], [gl_cv_cc_nomfi_supported], [gl_save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -W -Werror -Wno-missing-field-initializers" + CFLAGS="$CFLAGS -Wextra -Werror -Wno-missing-field-initializers" AC_COMPILE_IFELSE( [AC_LANG_PROGRAM([[]], [[]])], [gl_cv_cc_nomfi_supported=yes], @@ -68,7 +68,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], AC_CACHE_CHECK([whether -Wno-missing-field-initializers is needed], [gl_cv_cc_nomfi_needed], [gl_save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -W -Werror" + CFLAGS="$CFLAGS -Wextra -Werror" AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( [[int f (void) @@ -105,153 +105,41 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], # To compare this list to your installed GCC's, run this Bash command: # # comm -3 \ - # <((sed -n 's/^ *\(-[^ 0-9][^ ]*\) .*/\1/p' manywarnings.m4; \ + # <((sed -n 's/^ *\(-[^ 0-9][^ ]*\).*/\1/p' manywarnings.m4; \ # awk '/^[^#]/ {print $1}' ../build-aux/gcc-warning.spec) | sort) \ # <(LC_ALL=C gcc --help=warnings | sed -n 's/^ \(-[^ ]*\) .*/\1/p' | sort) - gl_manywarn_set= - for gl_manywarn_item in -fno-common \ - -W \ - -Wabsolute-value \ - -Waddress \ - -Waddress-of-packed-member \ - -Waggressive-loop-optimizations \ + $1= + for gl_manywarn_item in -fanalyzer -fno-common \ -Wall \ - -Wanalyzer-double-fclose \ - -Wanalyzer-double-free \ - -Wanalyzer-exposure-through-output-file \ - -Wanalyzer-file-leak \ - -Wanalyzer-free-of-non-heap \ - -Wanalyzer-malloc-leak \ - -Wanalyzer-null-argument \ - -Wanalyzer-null-dereference \ - -Wanalyzer-possible-null-argument \ - -Wanalyzer-possible-null-dereference \ - -Wanalyzer-stale-setjmp-buffer \ - -Wanalyzer-tainted-array-index \ - -Wanalyzer-too-complex \ - -Wanalyzer-unsafe-call-within-signal-handler \ - -Wanalyzer-use-after-free \ - -Wanalyzer-use-of-pointer-in-stale-stack-frame \ -Warith-conversion \ - -Wattribute-warning \ - -Wattributes \ -Wbad-function-cast \ - -Wbool-compare \ - -Wbool-operation \ - -Wbuiltin-declaration-mismatch \ - -Wbuiltin-macro-redefined \ - -Wcannot-profile \ - -Wcast-align \ -Wcast-align=strict \ - -Wcast-function-type \ - -Wchar-subscripts \ - -Wclobbered \ - -Wcomment \ - -Wcomments \ - -Wcoverage-mismatch \ - -Wcpp \ - -Wdangling-else \ -Wdate-time \ - -Wdeprecated \ - -Wdeprecated-declarations \ - -Wdesignated-init \ -Wdisabled-optimization \ - -Wdiscarded-array-qualifiers \ - -Wdiscarded-qualifiers \ - -Wdiv-by-zero \ -Wdouble-promotion \ -Wduplicated-branches \ -Wduplicated-cond \ - -Wduplicate-decl-specifier \ - -Wempty-body \ - -Wendif-labels \ - -Wenum-compare \ - -Wenum-conversion \ - -Wexpansion-to-defined \ -Wextra \ - -Wformat-contains-nul \ - -Wformat-diag \ - -Wformat-extra-args \ - -Wformat-nonliteral \ - -Wformat-security \ -Wformat-signedness \ - -Wformat-y2k \ - -Wformat-zero-length \ - -Wframe-address \ - -Wfree-nonheap-object \ - -Whsa \ - -Wif-not-aligned \ - -Wignored-attributes \ - -Wignored-qualifiers \ - -Wimplicit \ - -Wimplicit-function-declaration \ - -Wimplicit-int \ - -Wincompatible-pointer-types \ -Winit-self \ -Winline \ - -Wint-conversion \ - -Wint-in-bool-context \ - -Wint-to-pointer-cast \ - -Winvalid-memory-model \ -Winvalid-pch \ - -Wlogical-not-parentheses \ -Wlogical-op \ - -Wmain \ - -Wmaybe-uninitialized \ - -Wmemset-elt-size \ - -Wmemset-transposed-args \ - -Wmisleading-indentation \ - -Wmissing-attributes \ - -Wmissing-braces \ -Wmissing-declarations \ - -Wmissing-field-initializers \ -Wmissing-include-dirs \ - -Wmissing-parameter-type \ - -Wmissing-profile \ -Wmissing-prototypes \ - -Wmultichar \ - -Wmultistatement-macros \ - -Wnarrowing \ -Wnested-externs \ - -Wnonnull \ - -Wnonnull-compare \ -Wnull-dereference \ - -Wodr \ - -Wold-style-declaration \ -Wold-style-definition \ -Wopenmp-simd \ - -Woverflow \ -Woverlength-strings \ - -Woverride-init \ -Wpacked \ - -Wpacked-bitfield-compat \ - -Wpacked-not-aligned \ - -Wparentheses \ -Wpointer-arith \ - -Wpointer-compare \ - -Wpointer-sign \ - -Wpointer-to-int-cast \ - -Wpragmas \ - -Wpsabi \ - -Wrestrict \ - -Wreturn-local-addr \ - -Wreturn-type \ - -Wscalar-storage-order \ - -Wsequence-point \ -Wshadow \ - -Wshift-count-negative \ - -Wshift-count-overflow \ - -Wshift-negative-value \ - -Wsizeof-array-argument \ - -Wsizeof-pointer-div \ - -Wsizeof-pointer-memaccess \ -Wstack-protector \ - -Wstrict-aliasing \ -Wstrict-overflow \ -Wstrict-prototypes \ - -Wstring-compare \ - -Wstringop-truncation \ -Wsuggest-attribute=cold \ -Wsuggest-attribute=const \ -Wsuggest-attribute=format \ @@ -260,95 +148,63 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], -Wsuggest-attribute=pure \ -Wsuggest-final-methods \ -Wsuggest-final-types \ - -Wswitch \ - -Wswitch-bool \ - -Wswitch-outside-range \ - -Wswitch-unreachable \ -Wsync-nand \ -Wsystem-headers \ - -Wtautological-compare \ -Wtrampolines \ - -Wtrigraphs \ - -Wtype-limits \ -Wuninitialized \ -Wunknown-pragmas \ -Wunsafe-loop-optimizations \ - -Wunused \ - -Wunused-but-set-parameter \ - -Wunused-but-set-variable \ - -Wunused-function \ - -Wunused-label \ - -Wunused-local-typedefs \ -Wunused-macros \ - -Wunused-parameter \ - -Wunused-result \ - -Wunused-value \ - -Wunused-variable \ - -Wvarargs \ -Wvariadic-macros \ -Wvector-operation-performance \ -Wvla \ - -Wvolatile-register-var \ -Wwrite-strings \ - -Wzero-length-bounds \ \ ; do - gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item" + gl_AS_VAR_APPEND([$1], [" $gl_manywarn_item"]) done # gcc --help=warnings outputs an unusual form for these options; list # them here so that the above 'comm' command doesn't report a false match. - # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal. - # Also, AC_COMPUTE_INT requires it to fit in a long; it is 2**63 on - # the only platforms where it does not fit in a long, so make that - # a special case. - AC_MSG_CHECKING([max safe object size]) - AC_COMPUTE_INT([gl_alloc_max], - [LONG_MAX < (PTRDIFF_MAX < (size_t) -1 ? PTRDIFF_MAX : (size_t) -1) - ? -1 - : PTRDIFF_MAX < (size_t) -1 ? (long) PTRDIFF_MAX : (long) (size_t) -1], - [[#include <limits.h> - #include <stddef.h> - #include <stdint.h> - ]], - [gl_alloc_max=2147483647]) - case $gl_alloc_max in - -1) gl_alloc_max=9223372036854775807;; - esac - AC_MSG_RESULT([$gl_alloc_max]) - gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max" - gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2" - gl_manywarn_set="$gl_manywarn_set -Wattribute-alias=2" - gl_manywarn_set="$gl_manywarn_set -Wformat-overflow=2" - gl_manywarn_set="$gl_manywarn_set -Wformat-truncation=2" - gl_manywarn_set="$gl_manywarn_set -Wimplicit-fallthrough=5" - gl_manywarn_set="$gl_manywarn_set -Wnormalized=nfc" - gl_manywarn_set="$gl_manywarn_set -Wshift-overflow=2" - gl_manywarn_set="$gl_manywarn_set -Wstringop-overflow=2" - gl_manywarn_set="$gl_manywarn_set -Wunused-const-variable=2" - gl_manywarn_set="$gl_manywarn_set -Wvla-larger-than=4031" + gl_AS_VAR_APPEND([$1], [' -Warray-bounds=2']) + gl_AS_VAR_APPEND([$1], [' -Wattribute-alias=2']) + gl_AS_VAR_APPEND([$1], [' -Wformat-overflow=2']) + gl_AS_VAR_APPEND([$1], [' -Wformat=2']) + gl_AS_VAR_APPEND([$1], [' -Wformat-truncation=2']) + gl_AS_VAR_APPEND([$1], [' -Wimplicit-fallthrough=5']) + gl_AS_VAR_APPEND([$1], [' -Wshift-overflow=2']) + gl_AS_VAR_APPEND([$1], [' -Wunused-const-variable=2']) + gl_AS_VAR_APPEND([$1], [' -Wvla-larger-than=4031']) # These are needed for older GCC versions. if test -n "$GCC"; then case `($CC --version) 2>/dev/null` in 'gcc (GCC) '[[0-3]].* | \ 'gcc (GCC) '4.[[0-7]].*) - gl_manywarn_set="$gl_manywarn_set -fdiagnostics-show-option" - gl_manywarn_set="$gl_manywarn_set -funit-at-a-time" + gl_AS_VAR_APPEND([$1], [' -fdiagnostics-show-option']) + gl_AS_VAR_APPEND([$1], [' -funit-at-a-time']) ;; esac fi # Disable specific options as needed. if test "$gl_cv_cc_nomfi_needed" = yes; then - gl_manywarn_set="$gl_manywarn_set -Wno-missing-field-initializers" + gl_AS_VAR_APPEND([$1], [' -Wno-missing-field-initializers']) fi if test "$gl_cv_cc_uninitialized_supported" = no; then - gl_manywarn_set="$gl_manywarn_set -Wno-uninitialized" + gl_AS_VAR_APPEND([$1], [' -Wno-uninitialized']) fi - $1=$gl_manywarn_set + # Some warnings have too many false alarms in GCC 10.1. + # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93695 + gl_AS_VAR_APPEND([$1], [' -Wno-analyzer-double-free']) + # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=94458 + gl_AS_VAR_APPEND([$1], [' -Wno-analyzer-malloc-leak']) + # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=94851 + gl_AS_VAR_APPEND([$1], [' -Wno-analyzer-null-dereference']) + # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95758 + gl_AS_VAR_APPEND([$1], [' -Wno-analyzer-use-after-free']) AC_LANG_POP([C]) ]) diff --git a/m4/string_h.m4 b/m4/string_h.m4 index cc51337f0d1..516b346b311 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 @@ -5,7 +5,7 @@ # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -# serial 23 +# serial 24 # Written by Paul Eggert. @@ -87,7 +87,6 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS], HAVE_EXPLICIT_BZERO=1; AC_SUBST([HAVE_EXPLICIT_BZERO]) HAVE_FFSL=1; AC_SUBST([HAVE_FFSL]) HAVE_FFSLL=1; AC_SUBST([HAVE_FFSLL]) - HAVE_MEMCHR=1; AC_SUBST([HAVE_MEMCHR]) HAVE_DECL_MEMMEM=1; AC_SUBST([HAVE_DECL_MEMMEM]) HAVE_MEMPCPY=1; AC_SUBST([HAVE_MEMPCPY]) HAVE_DECL_MEMRCHR=1; AC_SUBST([HAVE_DECL_MEMRCHR]) diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4 index 3efba5a7b98..929144d155b 100644 --- a/m4/sys_stat_h.m4 +++ b/m4/sys_stat_h.m4 @@ -1,4 +1,4 @@ -# sys_stat_h.m4 serial 33 -*- Autoconf -*- +# sys_stat_h.m4 serial 34 -*- Autoconf -*- dnl Copyright (C) 2006-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -46,8 +46,8 @@ AC_DEFUN([gl_HEADER_SYS_STAT_H], dnl Check for declarations of anything we want to poison if the dnl corresponding gnulib module is not in use. gl_WARN_ON_USE_PREPARE([[#include <sys/stat.h> - ]], [fchmodat fstat fstatat futimens lchmod lstat mkdirat mkfifo mkfifoat - mknod mknodat stat utimensat]) + ]], [fchmodat fstat fstatat futimens getumask lchmod lstat + mkdirat mkfifo mkfifoat mknod mknodat stat utimensat]) AC_REQUIRE([AC_C_RESTRICT]) ]) @@ -68,6 +68,7 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS], GNULIB_FSTAT=0; AC_SUBST([GNULIB_FSTAT]) GNULIB_FSTATAT=0; AC_SUBST([GNULIB_FSTATAT]) GNULIB_FUTIMENS=0; AC_SUBST([GNULIB_FUTIMENS]) + GNULIB_GETUMASK=0; AC_SUBST([GNULIB_GETUMASK]) GNULIB_LCHMOD=0; AC_SUBST([GNULIB_LCHMOD]) GNULIB_LSTAT=0; AC_SUBST([GNULIB_LSTAT]) GNULIB_MKDIRAT=0; AC_SUBST([GNULIB_MKDIRAT]) @@ -82,6 +83,7 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS], HAVE_FCHMODAT=1; AC_SUBST([HAVE_FCHMODAT]) HAVE_FSTATAT=1; AC_SUBST([HAVE_FSTATAT]) HAVE_FUTIMENS=1; AC_SUBST([HAVE_FUTIMENS]) + HAVE_GETUMASK=1; AC_SUBST([HAVE_GETUMASK]) HAVE_LCHMOD=1; AC_SUBST([HAVE_LCHMOD]) HAVE_LSTAT=1; AC_SUBST([HAVE_LSTAT]) HAVE_MKDIRAT=1; AC_SUBST([HAVE_MKDIRAT]) diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4 index dfa38f85d60..b4734daf603 100644 --- a/m4/unistd_h.m4 +++ b/m4/unistd_h.m4 @@ -1,4 +1,4 @@ -# unistd_h.m4 serial 80 +# unistd_h.m4 serial 81 dnl Copyright (C) 2006-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -120,7 +120,6 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], dnl Assume proper GNU behavior unless another module says otherwise. HAVE_CHOWN=1; AC_SUBST([HAVE_CHOWN]) HAVE_COPY_FILE_RANGE=1; AC_SUBST([HAVE_COPY_FILE_RANGE]) - HAVE_DUP2=1; AC_SUBST([HAVE_DUP2]) HAVE_DUP3=1; AC_SUBST([HAVE_DUP3]) HAVE_EUIDACCESS=1; AC_SUBST([HAVE_EUIDACCESS]) HAVE_FACCESSAT=1; AC_SUBST([HAVE_FACCESSAT]) diff --git a/src/Makefile.in b/src/Makefile.in index 552dd2e50ae..72d69fb7a3e 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -323,8 +323,7 @@ INTERVALS_H = dispextern.h intervals.h composite.h GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ -GMP_LIB = @GMP_LIB@ -GMP_OBJ = @GMP_OBJ@ +LIB_GMP = @LIB_GMP@ RUN_TEMACS = ./temacs @@ -531,7 +530,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \ - $(JSON_LIBS) $(GMP_LIB) + $(JSON_LIBS) $(LIB_GMP) ## FORCE it so that admin/unidata can decide whether this file is ## up-to-date. Although since charprop depends on bootstrap-emacs, diff --git a/src/bignum.h b/src/bignum.h index 4a906c3c0eb..251a19e338a 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -22,12 +22,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef BIGNUM_H #define BIGNUM_H -#ifdef HAVE_GMP -# include <gmp.h> -#else -# include "mini-gmp.h" -#endif - +#include <gmp.h> #include "lisp.h" /* Number of data bits in a limb. */ diff --git a/src/emacs.c b/src/emacs.c index 45a215b66e2..8a6bb3ad228 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2333,6 +2333,8 @@ DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P", doc: /* Exit the Emacs job and kill it. If ARG is an integer, return ARG as the exit program code. If ARG is a string, stuff it as keyboard input. +Any other value of ARG, or ARG omitted, means return an +exit code that indicates successful program termination. This function is called upon receipt of the signals SIGTERM or SIGHUP, and upon SIGINT in batch mode. diff --git a/src/fns.c b/src/fns.c index a95a4b6e678..811d6e82001 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1530,11 +1530,21 @@ same_float (Lisp_Object x, Lisp_Object y) return !neql; } +/* True if X can be compared using `eq'. + This predicate is approximative, for maximum speed. */ +static bool +eq_comparable_value (Lisp_Object x) +{ + return SYMBOLP (x) || FIXNUMP (x); +} + DEFUN ("member", Fmember, Smember, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. The value is actually the tail of LIST whose car is ELT. */) (Lisp_Object elt, Lisp_Object list) { + if (eq_comparable_value (elt)) + return Fmemq (elt, list); Lisp_Object tail = list; FOR_EACH_TAIL (tail) if (! NILP (Fequal (elt, XCAR (tail)))) @@ -1622,6 +1632,8 @@ The value is actually the first element of ALIST whose car equals KEY. Equality is defined by TESTFN if non-nil or by `equal' if nil. */) (Lisp_Object key, Lisp_Object alist, Lisp_Object testfn) { + if (eq_comparable_value (key) && NILP (testfn)) + return Fassq (key, alist); Lisp_Object tail = alist; FOR_EACH_TAIL (tail) { @@ -1672,6 +1684,8 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, The value is actually the first element of ALIST whose cdr equals KEY. */) (Lisp_Object key, Lisp_Object alist) { + if (eq_comparable_value (key)) + return Frassq (key, alist); Lisp_Object tail = alist; FOR_EACH_TAIL (tail) { diff --git a/src/gtkutil.c b/src/gtkutil.c index 5d1ce6de97c..1fe160acca9 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -17,6 +17,13 @@ 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/>. */ +/* FIXME: This code is problematic; it misuses GTK, so the GTK + developers don't think they should fix the resulting problems in GTK + itself. The right way to fix this is by rewriting the code in Emacs + to use GTK3 properly. As of 2020, there is a project to do this. + Talk with Yuuki Harano <masm+emacs@masm11.me> if you are interested + in doing substantial work on this. */ + #include <config.h> #ifdef USE_GTK diff --git a/src/image.c b/src/image.c index c8a192aaaf1..e7e0a93313b 100644 --- a/src/image.c +++ b/src/image.c @@ -8274,7 +8274,10 @@ gif_load (struct frame *f, struct image *img) rc = DGifSlurp (gif); if (rc == GIF_ERROR || gif->ImageCount <= 0) { - image_error ("Error reading `%s'", img->spec); + if (NILP (specified_data)) + image_error ("Error reading `%s'", img->spec); + else + image_error ("Error reading GIF data"); gif_close (gif, NULL); return 0; } diff --git a/src/json.c b/src/json.c index 30027675580..814afc6d741 100644 --- a/src/json.c +++ b/src/json.c @@ -365,6 +365,7 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, Lisp_Object key = HASH_KEY (h, i); if (!EQ (key, Qunbound)) { + CHECK_STRING (key); Lisp_Object ekey = json_encode (key); /* We can't specify the length, so the string must be NUL-terminated. */ @@ -975,6 +976,7 @@ usage: (json-parse-string STRING &rest ARGS) */) #endif Lisp_Object string = args[0]; + CHECK_STRING (string); Lisp_Object encoded = json_encode (string); check_string_without_embedded_nuls (encoded); struct json_configuration conf = diff --git a/src/keyboard.c b/src/keyboard.c index f9b9399d502..5fa58abce1d 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -10531,7 +10531,7 @@ The value is always a vector. */) DEFUN ("clear-this-command-keys", Fclear_this_command_keys, Sclear_this_command_keys, 0, 1, 0, doc: /* Clear out the vector that `this-command-keys' returns. -Also clear the record of the last 100 events, unless optional arg +Also clear the record of the last 300 input events, unless optional arg KEEP-RECORD is non-nil. */) (Lisp_Object keep_record) { diff --git a/src/mini-gmp-emacs.c b/src/mini-gmp-emacs.c deleted file mode 100644 index b8399b075e0..00000000000 --- a/src/mini-gmp-emacs.c +++ /dev/null @@ -1,32 +0,0 @@ -/* Tailor mini-gmp.c for GNU Emacs - -Copyright 2018-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/>. */ - -#include <config.h> - -#include <stddef.h> - -/* Pacify GCC -Wsuggest-attribute=malloc. */ -static void *gmp_default_alloc (size_t) ATTRIBUTE_MALLOC; - -/* Pacify GCC -Wunused-variable for variables used only in 'assert' calls. */ -#if defined NDEBUG && GNUC_PREREQ (4, 6, 0) -# pragma GCC diagnostic ignored "-Wunused-variable" -#endif - -#include "mini-gmp.c" diff --git a/src/w32proc.c b/src/w32proc.c index 16e32e4c58d..c50f246a454 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -2790,11 +2790,11 @@ sys_kill (pid_t pid, int sig) /* Set the foreground window to the child. */ if (SetForegroundWindow (cp->hwnd)) { - /* Record the state of the Ctrl key: the user could - have it depressed while we are simulating Ctrl-C, - in which case we will have to leave the state of - Ctrl depressed when we are done. */ - short ctrl_state = GetKeyState (VK_CONTROL) & 0x8000; + /* Record the state of the left Ctrl key: the user + could have it depressed while we are simulating + Ctrl-C, in which case we will have to leave the + state of that Ctrl depressed when we are done. */ + short ctrl_state = GetKeyState (VK_LCONTROL) & 0x8000; /* Generate keystrokes as if user had typed Ctrl-Break or Ctrl-C. */ diff --git a/src/xdisp.c b/src/xdisp.c index e454fd7b83f..eb7f3e7baa1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1872,10 +1872,13 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, /* Account for line-number display, if IT3 still didn't. This can happen if START - 1 is the first or the last character on its display line. */ - if (it3.lnum_pixel_width > 0) - top_x += it3.lnum_pixel_width; - else if (it.line_number_produced_p) - top_x += it.lnum_pixel_width; + if (!it3.line_number_produced_p) + { + if (it3.lnum_pixel_width > 0) + top_x += it3.lnum_pixel_width; + else if (it.line_number_produced_p) + top_x += it.lnum_pixel_width; + } /* Normally, we would exit the above loop because we found the display element whose character position is CHARPOS. For the contingency that we @@ -26382,6 +26385,22 @@ decode_mode_spec (struct window *w, register int c, int field_width, startpos = marker_position (w->start); startpos_byte = marker_byte_position (w->start); height = WINDOW_TOTAL_LINES (w); + /* We cannot cope with w->start being outside of the + accessible portion of the buffer; in particular, + display_count_lines call below might infloop if called with + startpos_byte outside of the [BEGV_BYTE..ZV_BYTE] region. + Such w->start means we were called in some "creative" way + when the buffer's restriction was changed, but the window + wasn't yet redisplayed after that. If that happens, we + need to determine a new base line. */ + if (!(BUF_BEGV_BYTE (b) <= startpos_byte + && startpos_byte <= BUF_ZV_BYTE (b))) + { + startpos = BUF_BEGV (b); + startpos_byte = BUF_BEGV_BYTE (b); + w->base_line_pos = 0; + w->base_line_number = 0; + } /* If we decided that this buffer isn't suitable for line numbers, don't forget that too fast. */ diff --git a/test/Makefile.in b/test/Makefile.in index f03c194a7cb..c4840670e61 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -255,12 +255,10 @@ else FPIC_CFLAGS = -fPIC endif -GMP_LIB = @GMP_LIB@ -GMP_OBJ = $(if @GMP_OBJ@, ../src/@GMP_OBJ@) +GMP_H = @GMP_H@ +LIB_GMP = @LIB_GMP@ -# Note: emacs-module.h is generated from emacs-module.h.in, hence we -# look in ../src, not $(srcdir)/../src. -MODULE_CFLAGS = -I../src -I$(srcdir)/../lib \ +MODULE_CFLAGS = -I../src -I$(srcdir)/../src -I../lib -I$(srcdir)/../lib \ $(FPIC_CFLAGS) $(PROFILING_CFLAGS) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS) @@ -273,7 +271,8 @@ src/emacs-module-tests.log src/emacs-module-tests.elc: $(test_module) $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h $(AM_V_at)${MKDIR_P} $(dir $@) $(AM_V_CCLD)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \ - -o $@ $< $(GMP_LIB) $(GMP_OBJ:.o=.c) \ + -o $@ $< $(LIB_GMP) \ + $(and $(GMP_H),$(srcdir)/../lib/mini-gmp-gnulib.c) \ $(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c endif diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 5e3112f4471..1e64bcd65f1 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -43,12 +43,7 @@ uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *); # include <unistd.h> #endif -#ifdef HAVE_GMP #include <gmp.h> -#else -#include "mini-gmp.h" -#endif - #include <emacs-module.h> #include "timespec.h" diff --git a/test/lisp/descr-text-tests.el b/test/lisp/descr-text-tests.el index 74fcdf5af37..b060dffb0ff 100644 --- a/test/lisp/descr-text-tests.el +++ b/test/lisp/descr-text-tests.el @@ -75,18 +75,18 @@ (goto-char (point-min)) (should (eq ?a (following-char))) ; make sure we are where we think we are ;; Function should return nil for an ASCII character. - (should (not (describe-char-eldoc))) + (should (not (describe-char-eldoc 'ignore))) (goto-char (1+ (point))) (should (eq ?… (following-char))) (let ((eldoc-echo-area-use-multiline-p t)) ;; Function should return description of an Unicode character. (should (equal "U+2026: Horizontal ellipsis (Po: Punctuation, Other)" - (describe-char-eldoc)))) + (describe-char-eldoc 'ignore)))) (goto-char (point-max)) ;; At the end of the buffer, function should return nil and not blow up. - (should (not (describe-char-eldoc))))) + (should (not (describe-char-eldoc 'ignore))))) (provide 'descr-text-test) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index bfe2d06a61b..c235dd43fcc 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -363,10 +363,10 @@ bytecompiled code, and their results compared.") (byte-compile-warnings nil) (v0 (condition-case nil (eval pat) - (error nil))) + (error 'bytecomp-check-error))) (v1 (condition-case nil (funcall (byte-compile (list 'lambda nil pat))) - (error nil)))) + (error 'bytecomp-check-error)))) (equal v0 v1))) (put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) @@ -374,10 +374,10 @@ bytecompiled code, and their results compared.") (defun bytecomp-explain-1 (pat) (let ((v0 (condition-case nil (eval pat) - (error nil))) + (error 'bytecomp-check-error))) (v1 (condition-case nil (funcall (byte-compile (list 'lambda nil pat))) - (error nil)))) + (error 'bytecomp-check-error)))) (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." pat v0 v1))) @@ -402,10 +402,10 @@ Subtests signal errors if something goes wrong." (dolist (pat byte-opt-testsuite-arith-data) (condition-case nil (setq v0 (eval pat)) - (error (setq v0 nil))) + (error (setq v0 'bytecomp-check-error))) (condition-case nil (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) - (error (setq v1 nil))) + (error (setq v1 'bytecomp-check-error))) (insert (format "%s" pat)) (indent-to-column 65) (if (equal v0 v1) @@ -561,11 +561,11 @@ bytecompiled code, and their results compared.") (byte-compile-warnings nil) (v0 (condition-case nil (eval pat t) - (error nil))) + (error 'bytecomp-check-error))) (v1 (condition-case nil (funcall (let ((lexical-binding t)) (byte-compile `(lambda nil ,pat)))) - (error nil)))) + (error 'bytecomp-check-error)))) (equal v0 v1))) (put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1) @@ -573,11 +573,11 @@ bytecompiled code, and their results compared.") (defun bytecomp-lexbind-explain-1 (pat) (let ((v0 (condition-case nil (eval pat t) - (error nil))) + (error 'bytecomp-check-error))) (v1 (condition-case nil (funcall (let ((lexical-binding t)) (byte-compile (list 'lambda nil pat)))) - (error nil)))) + (error 'bytecomp-check-error)))) (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." pat v0 v1))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1f24ba2786f..34782e7f151 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -6035,18 +6035,22 @@ Use the `ls' command." "银河系漫游指南系列" "Автостопом по гала́ктике" ;; Use codepoints without a name. See Bug#31272. - "bung") + "bung" + ;; Use codepoints from Supplementary Multilingual Plane (U+10000 + ;; to U+1FFFF). + "🌈🍒👋") (when (tramp--test-expensive-test) (delete-dups (mapcar - ;; Use all available language specific snippets. Filter out - ;; strings which use unencodable characters. + ;; Use all available language specific snippets. (lambda (x) (and (stringp (setq x (eval (get-language-info (car x) 'sample-text)))) - (not (unencodable-char-position - 0 (length x) file-name-coding-system nil x)) + ;; Filter out strings which use unencodable characters. + (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p)) + (unencodable-char-position + 0 (length x) file-name-coding-system nil x))) ;; ?\n and ?/ shouldn't be part of any file name. ?\t, ;; ?. and ?? do not work for "smb" method. (replace-regexp-in-string "[\t\n/.?]" "" x))) diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 2ba00656862..2de533e5eb9 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -194,7 +194,7 @@ (dotimes (i 3) (should (equal (elisp-mode-tests--face-propertized-string - (elisp--highlight-function-argument 'foo "(A B C)" (1+ i) "foo: ")) + (elisp--highlight-function-argument 'foo "(A B C)" (1+ i))) (propertize (nth i '("A" "B" "C")) 'face 'eldoc-highlight-function-argument))))) @@ -206,7 +206,7 @@ (cl-flet ((bold-arg (i) (elisp-mode-tests--face-propertized-string (elisp--highlight-function-argument - 'foo "(PROMPT LST &key A B C)" i "foo: ")))) + 'foo "(PROMPT LST &key A B C)" i)))) (should-not (bold-arg 0)) (progn (forward-sexp) (forward-char)) (should (equal (bold-arg 1) "PROMPT")) @@ -226,7 +226,7 @@ (cl-flet ((bold-arg (i) (elisp-mode-tests--face-propertized-string (elisp--highlight-function-argument - 'foo "(X &key A B C)" i "foo: ")))) + 'foo "(X &key A B C)" i)))) (should-not (bold-arg 0)) ;; The `:b' specifies positional arg `X'. (progn (forward-sexp) (forward-char)) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 60cd6ea996e..6b3e63653be 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -3553,7 +3553,7 @@ def foo(): ;;; Code check -;;; Eldoc +;;; ElDoc (ert-deftest python-eldoc--get-symbol-at-point-1 () "Test paren handling." diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 6851b890451..411b4505da0 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -288,6 +288,9 @@ during garbage collection." (with-temp-buffer (let ((standard-output (current-buffer))) (describe-function-1 #'mod-test-sum) + (goto-char (point-min)) + (while (re-search-forward "`[^']*/data/emacs-module/" nil t) + (replace-match "`data/emacs-module/")) (should (equal (buffer-substring-no-properties 1 (point-max)) (format "a module function in `data/emacs-module/mod-test%s'. diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 7eeef885198..028f92f29d3 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -296,5 +296,17 @@ Test with both unibyte and multibyte strings." (1+ most-positive-fixnum) (1- most-negative-fixnum))))) +(ert-deftest json-parse-string/wrong-type () + "Check that Bug#42113 is fixed." + (skip-unless (fboundp 'json-parse-string)) + (should-error (json-parse-string 1) :type 'wrong-type-argument)) + +(ert-deftest json-serialize/wrong-hash-key-type () + "Check that Bug#42113 is fixed." + (skip-unless (fboundp 'json-serialize)) + (let ((table (make-hash-table :test #'eq))) + (puthash 1 2 table) + (should-error (json-serialize table) :type 'wrong-type-argument))) + (provide 'json-tests) ;;; json-tests.el ends here |