diff options
60 files changed, 1227 insertions, 397 deletions
diff --git a/build-aux/config.guess b/build-aux/config.guess index e94095c5fbe..9aff91cfd03 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2020 Free Software Foundation, Inc. -timestamp='2020-07-12' +timestamp='2020-08-17' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -404,7 +404,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in # If there is a compiler, see if it is configured for 64-bit objects. # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. # This test works for both compilers. - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then + if test "$CC_FOR_BUILD" != no_compiler_found; then if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ grep IS_64BIT_ARCH >/dev/null @@ -544,10 +544,10 @@ EOF AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ "$UNAME_PROCESSOR" = mc88100 ] || [ "$UNAME_PROCESSOR" = mc88110 ] + if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110 then - if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] || \ - [ "$TARGET_BINARY_INTERFACE"x = x ] + if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \ + test "$TARGET_BINARY_INTERFACE"x = x then echo m88k-dg-dgux"$UNAME_RELEASE" else @@ -580,7 +580,7 @@ EOF echo i386-ibm-aix exit ;; ia64:AIX:*:*) - if [ -x /usr/bin/oslevel ] ; then + if test -x /usr/bin/oslevel ; then IBM_REV=`/usr/bin/oslevel` else IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" @@ -620,7 +620,7 @@ EOF else IBM_ARCH=powerpc fi - if [ -x /usr/bin/lslpp ] ; then + if test -x /usr/bin/lslpp ; then IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` else @@ -655,7 +655,7 @@ EOF 9000/31?) HP_ARCH=m68000 ;; 9000/[34]??) HP_ARCH=m68k ;; 9000/[678][0-9][0-9]) - if [ -x /usr/bin/getconf ]; then + if test -x /usr/bin/getconf; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` case "$sc_cpu_version" in @@ -669,7 +669,7 @@ EOF esac ;; esac fi - if [ "$HP_ARCH" = "" ]; then + if test "$HP_ARCH" = ""; then set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" @@ -708,7 +708,7 @@ EOF test -z "$HP_ARCH" && HP_ARCH=hppa fi ;; esac - if [ "$HP_ARCH" = hppa2.0w ] + if test "$HP_ARCH" = hppa2.0w then set_cc_for_build @@ -782,7 +782,7 @@ EOF echo hppa1.0-hp-osf exit ;; i*86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then + if test -x /usr/sbin/sysversion ; then echo "$UNAME_MACHINE"-unknown-osf1mk else echo "$UNAME_MACHINE"-unknown-osf1 @@ -1097,7 +1097,7 @@ EOF x86_64:Linux:*:*) set_cc_for_build LIBCABI=$LIBC - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then + if test "$CC_FOR_BUILD" != no_compiler_found; then if (echo '#ifdef __ILP32__'; echo IS_X32; echo '#endif') | \ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ grep IS_X32 >/dev/null @@ -1294,7 +1294,7 @@ EOF echo mips-sony-newsos6 exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then + if test -d /usr/nec; then echo mips-nec-sysv"$UNAME_RELEASE" else echo mips-unknown-sysv"$UNAME_RELEASE" @@ -1359,7 +1359,7 @@ EOF else set_cc_for_build fi - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then + if test "$CC_FOR_BUILD" != no_compiler_found; then if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ grep IS_64BIT_ARCH >/dev/null diff --git a/build-aux/config.sub b/build-aux/config.sub index 3d9a8dc3d5a..0753e308458 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2020 Free Software Foundation, Inc. -timestamp='2020-07-10' +timestamp='2020-08-17' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1278,7 +1278,7 @@ esac # Decode manufacturer-specific aliases for certain operating systems. -if [ x$basic_os != x ] +if test x$basic_os != x then # First recognize some ad-hoc caes, or perhaps split kernel-os, or else just diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index de449e31c37..19aaca962da 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -79,6 +79,29 @@ The former lists all the files with extension @samp{.el} in directory @samp{foo}. The latter lists the files with extension @samp{.el} in all the subdirectories of @samp{foo}. +@cindex globstar, in Dired +On Posix systems, when the system shell supports @dfn{globstar}, a +recursive globbing feature, and that support is enabled, you can use +recursive globbing in Dired: + +@example +C-x d ~/foo/**/*.el @key{RET} +@end example + +This command produces a directory listing with all the files with +extension @samp{.el}, descending recursively in all the subdirectories +of @samp{foo}. Note that there are small differences in the +implementation of globstar between different shells. Check your shell +manual to know the expected behavior. + +@vindex dired-maybe-use-globstar +@vindex dired-enable-globstar-in-shell +If the shell supports globstar, but that support is disabled by +default, you can still let Dired use this feature by customizing +@code{dired-maybe-use-globstar} to a non-@code{nil} value; then Dired +will enable globstar for those shells for which it knows how (see +@code{dired-enable-globstar-in-shell} for the list of those shells). + The usual history and completion commands can be used in the minibuffer; in particular, @kbd{M-n} puts the name of the visited file (if any) in the minibuffer (@pxref{Minibuffer History}). diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 75ef520d62a..e7b8745a044 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1808,6 +1808,29 @@ logical lines, so having a fringe indicator for each wrapped line would be visually distracting. You can change this by customizing the variable @code{visual-line-fringe-indicators}. +@vindex word-wrap-by-category +@findex modify-category-entry +@findex char-category-set +@findex category-set-mnemonics + By default, Emacs only breaks lines after whitespace characters. +That produces incorrect results when CJK and Latin text are mixed +together (because CJK characters don't use whitespace to separate +words). You can customize the option @code{word-wrap-by-category} to +allow Emacs to break lines after any character with ``|'' category +(@pxref{Categories,,, elisp, the Emacs Lisp Reference Manual}), which +provides better support for CJK characters. Also, if this variable is +set using Customize, Emacs automatically loads @file{kinsoku.el}. +When @file{kinsoku.el} is loaded, Emacs respects kinsoku rules when +breaking lines. That means characters with the ``>'' category don't +appear at the beginning of a line (e.g., U+FF0C FULLWIDTH COMMA), and +characters with the ``<'' category don't appear at the end of a line +(e.g., U+300A LEFT DOUBLE ANGLE BRACKET). You can view the category +set of a character using the commands @code{char-category-set} and +@code{category-set-mnemonics}, or by typing @kbd{C-u C-x =} with point +on the character and looking at the ``category'' section in the +report. You can add categories to a character using the command +@code{modify-category-entry}. + @node Display Custom @section Customization of Display diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 317a1979e9d..c8b21e701c7 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2945,6 +2945,9 @@ browse-url @key{RET}}. @table @kbd @item M-x goto-address-mode Activate URLs and e-mail addresses in the current buffer. + +@item M-x global-goto-address-mode +Activate @code{goto-address-mode} in all buffers. @end table @kindex C-c RET @r{(Goto Address mode)} diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 2898cb4d2b4..26b212d05eb 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2163,15 +2163,24 @@ the backquote (@pxref{Backquote}), but quotes code and accepts only @end defmac @defmac inline-letevals (bindings@dots{}) body@dots{} -This is similar to @code{let} (@pxref{Local Variables}): it sets up -local variables as specified by @var{bindings}, and then evaluates -@var{body} with those bindings in effect. Each element of -@var{bindings} should be either a symbol or a list of the form -@w{@code{(@var{var} @var{expr})}}; the result is to evaluate -@var{expr} and bind @var{var} to the result. The tail of -@var{bindings} can be either @code{nil} or a symbol which should hold -a list of arguments, in which case each argument is evaluated, and the -symbol is bound to the resulting list. +This provides a convenient way to ensure that the arguments to an +inlined function are evaluated exactly once, as well as to create +local variables. + +It's similar to @code{let} (@pxref{Local Variables}): It sets up local +variables as specified by @var{bindings}, and then evaluates +@var{body} with those bindings in effect. + +Each element of @var{bindings} should be either a symbol or a list of +the form @w{@code{(@var{var} @var{expr})}}; the result is to evaluate +@var{expr} and bind @var{var} to the result. However, when an element +of @var{bindings} is just a symbol @var{var}, the result of evaluating +@var{var} is re-bound to @var{var} (which is quite different from the +way @code{let} works). + +The tail of @var{bindings} can be either @code{nil} or a symbol which +should hold a list of arguments, in which case each argument is +evaluated, and the symbol is bound to the resulting list. @end defmac @defmac inline-const-p expression diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 91419702ca1..751adcff5a8 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -332,6 +332,8 @@ if provided; otherwise @var{n} defaults to @code{nil}. @node Text Lines @subsection Motion by Text Lines @cindex lines +@cindex logical lines, moving by +@cindex physical lines, moving by Text lines are portions of the buffer delimited by newline characters, which are regarded as part of the previous line. The first text line @@ -518,6 +520,7 @@ beginning or end of a line. @node Screen Lines @subsection Motion by Screen Lines @cindex screen lines, moving by +@cindex visual lines, moving by The line functions in the previous section count text lines, delimited only by newline characters. By contrast, these functions count screen @@ -93,6 +93,13 @@ specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow box if the point is on an image larger than 'SIZE' pixels in any dimension. ++++ +** New custom option 'word-wrap-by-category'. +When word-wrap is enabled, and this option is non-nil, that allows +Emacs to break lines after more characters than just whitespace +characters. In particular, this significantly improves word-wrapping +for CJK text mixed with Latin text. + --- *** Improved language transliteration in Malayalam input methods. Added a new Mozhi scheme. The inapplicable ITRANS scheme is now @@ -102,6 +109,13 @@ deprecated. Errors in the Inscript method were corrected. ** Rudimentary support for the 'st' terminal emulator. Emacs now supports 256 color display on the 'st' terminal emulator. +--- +** Mouse wheel scrolling now works on more parts of frame's display. +When using 'mwheel-mode', the mouse wheel will now scroll also when +the mouse cursor is on the scroll bars, fringes, margins, header line, +and mode line. ('mwheel-mode' is enabled by default on most graphical +displays.) + * Editing Changes in Emacs 28.1 @@ -222,6 +236,15 @@ time zones will use a form like "+0100" instead of "CET". ** Dired +++ +*** New user option 'dired-maybe-use-globstar'. +If set, enables globstar (recursive globbing) in shells that support +this feature, but turn it off by default. This allows producing +directory listings with files matching a wildcard in all the +subdirectories of a given directory. The new variable +'dired-enable-globstar-in-shell' lists which shells can have globstar +enabled, and how to enable it. + ++++ *** New user option 'dired-copy-dereference'. If set to non-nil, Dired will dereference symbolic links when copying. This can be switched off on a per-usage basis by providing @@ -260,9 +283,10 @@ invoke 'C-u C-x v s' ('vc-create-tag'). *** 'vc-hg' now uses 'hg summary' to populate extra 'vc-dir' headers. --- -*** New variable 'vc-git-revision-complete-only-branches' +*** New variable 'vc-git-revision-complete-only-branches'. If non-nil, only branches and remotes are considered when doing -completion over branch names. +completion over Git branch names. The default is nil, which causes +tags to be considered as well. ** Gnus @@ -464,7 +488,7 @@ key binding / / package-menu-filter-clear --- -+++ Column widths in 'list-packages' display can now be customized. +*** Column widths in 'list-packages' display can now be customized. See the new user options 'package-name-column-width', 'package-version-column-width', 'package-status-column-width', and 'package-archive-column-width'. @@ -656,6 +680,14 @@ sorted there. The commands have also been extended to work when the "parent" buffer is an archive mode (i.e., zip file or the like) or tar mode buffer. +--- +*** 'image-converter' is now restricted to formats in 'auto-mode-alist'. +When using external image converters, the external program is queried +for what formats it supports. This list may contain formats that are +problematic in some contexts (like PDFs), so this list is now filtered +based on 'auto-mode-alist'. Only file names that map to 'image-mode' +are now supported. + ** EWW +++ @@ -820,6 +852,19 @@ window after starting). This variable defaults to nil. ** Miscellaneous --- +*** New 'diff-mode' font locking face 'diff-error'. +This face is used for error messages from diff. + +--- +*** 'hs-minor-mode' now heeds 'hs-special-modes-alist' for derived modes. +The settings in 'hs-special-modes-alist' now also affect modes derived +from those mentioned in that alist. + ++++ +*** New global mode 'global-goto-address-mode' +This will enable 'goto-address-mode' in all buffers. + +--- *** 'C-s' in 'M-x' now searches over completions again. In Emacs 23, typing 'M-x' ('read-extended-command') and then 'C-s' (to do an interactive search) would search over possible completions. diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c index 1aa04363dac..e43aa42d5c4 100644 --- a/lib/careadlinkat.c +++ b/lib/careadlinkat.c @@ -38,66 +38,41 @@ #include "allocator.h" -/* Assuming the current directory is FD, get the symbolic link value - of FILENAME as a null-terminated string and put it into a buffer. - If FD is AT_FDCWD, FILENAME is interpreted relative to the current - working directory, as in openat. - - If the link is small enough to fit into BUFFER put it there. - BUFFER's size is BUFFER_SIZE, and BUFFER can be null - if BUFFER_SIZE is zero. - - If the link is not small, put it into a dynamically allocated - buffer managed by ALLOC. It is the caller's responsibility to free - the returned value if it is nonnull and is not BUFFER. A null - ALLOC stands for the standard allocator. - - The PREADLINKAT function specifies how to read links. It operates - like POSIX readlinkat() - <https://pubs.opengroup.org/onlinepubs/9699919799/functions/readlink.html> - but can assume that its first argument is the same as FD. - - If successful, return the buffer address; otherwise return NULL and - set errno. */ - -char * -careadlinkat (int fd, char const *filename, +enum { STACK_BUF_SIZE = 1024 }; + +/* Act like careadlinkat (see below), with an additional argument + STACK_BUF that can be used as temporary storage. + + If GCC_LINT is defined, do not inline this function with GCC 10.1 + and later, to avoid creating a pointer to the stack that GCC + -Wreturn-local-addr incorrectly complains about. See: + https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93644 + Although the noinline attribute can hurt performance a bit, no better way + to pacify GCC is known; even an explicit #pragma does not pacify GCC. + When the GCC bug is fixed this workaround should be limited to the + broken GCC versions. */ +#if (defined GCC_LINT || defined lint) && _GL_GNUC_PREREQ (10, 1) +__attribute__ ((__noinline__)) +#endif +static char * +readlink_stk (int fd, char const *filename, char *buffer, size_t buffer_size, struct allocator const *alloc, - ssize_t (*preadlinkat) (int, char const *, char *, size_t)) + ssize_t (*preadlinkat) (int, char const *, char *, size_t), + char stack_buf[STACK_BUF_SIZE]) { char *buf; size_t buf_size; size_t buf_size_max = SSIZE_MAX < SIZE_MAX ? (size_t) SSIZE_MAX + 1 : SIZE_MAX; - char stack_buf[1024]; - -#if (defined GCC_LINT || defined lint) && _GL_GNUC_PREREQ (10, 1) - /* Pacify preadlinkat without creating a pointer to the stack - that a broken gcc -Wreturn-local-addr would cry wolf about. See: - https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95044 - This workaround differs from the mainline code, but - no other way to pacify GCC 10.1.0 is known; even an explicit - #pragma does not pacify GCC. When the GCC bug is fixed this - workaround should be limited to the broken GCC versions. */ -# define WORK_AROUND_GCC_BUG_95044 -#endif if (! alloc) alloc = &stdlib_allocator; if (!buffer) { -#ifdef WORK_AROUND_GCC_BUG_95044 - buffer = alloc->allocate (sizeof stack_buf); -#else - /* Allocate the initial buffer on the stack. This way, in the - common case of a symlink of small size, we get away with a - single small malloc() instead of a big malloc() followed by a - shrinking realloc(). */ buffer = stack_buf; -#endif - buffer_size = sizeof stack_buf; + buffer_size = STACK_BUF_SIZE; } buf = buffer; @@ -172,3 +147,44 @@ careadlinkat (int fd, char const *filename, errno = ENOMEM; return NULL; } + + +/* Assuming the current directory is FD, get the symbolic link value + of FILENAME as a null-terminated string and put it into a buffer. + If FD is AT_FDCWD, FILENAME is interpreted relative to the current + working directory, as in openat. + + If the link is small enough to fit into BUFFER put it there. + BUFFER's size is BUFFER_SIZE, and BUFFER can be null + if BUFFER_SIZE is zero. + + If the link is not small, put it into a dynamically allocated + buffer managed by ALLOC. It is the caller's responsibility to free + the returned value if it is nonnull and is not BUFFER. A null + ALLOC stands for the standard allocator. + + The PREADLINKAT function specifies how to read links. It operates + like POSIX readlinkat() + <https://pubs.opengroup.org/onlinepubs/9699919799/functions/readlink.html> + but can assume that its first argument is the same as FD. + + If successful, return the buffer address; otherwise return NULL and + set errno. */ + +char * +careadlinkat (int fd, char const *filename, + char *buffer, size_t buffer_size, + struct allocator const *alloc, + ssize_t (*preadlinkat) (int, char const *, char *, size_t)) +{ + /* Allocate the initial buffer on the stack. This way, in the + common case of a symlink of small size, we get away with a + single small malloc instead of a big malloc followed by a + shrinking realloc. + + If GCC -Wreturn-local-addr warns about this buffer, the warning + is bogus; see readlink_stk. */ + char stack_buf[STACK_BUF_SIZE]; + return readlink_stk (fd, filename, buffer, buffer_size, alloc, + preadlinkat, stack_buf); +} diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 7b4fc74219f..78b4542d80a 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -424,6 +424,7 @@ GNULIB_SECURE_GETENV = @GNULIB_SECURE_GETENV@ GNULIB_SELECT = @GNULIB_SELECT@ GNULIB_SETENV = @GNULIB_SETENV@ GNULIB_SETHOSTNAME = @GNULIB_SETHOSTNAME@ +GNULIB_SIGABBREV_NP = @GNULIB_SIGABBREV_NP@ GNULIB_SIGACTION = @GNULIB_SIGACTION@ GNULIB_SIGNAL_H_SIGPIPE = @GNULIB_SIGNAL_H_SIGPIPE@ GNULIB_SIGPROCMASK = @GNULIB_SIGPROCMASK@ @@ -644,6 +645,7 @@ HAVE_SECURE_GETENV = @HAVE_SECURE_GETENV@ HAVE_SETENV = @HAVE_SETENV@ HAVE_SETHOSTNAME = @HAVE_SETHOSTNAME@ HAVE_SETSTATE = @HAVE_SETSTATE@ +HAVE_SIGABBREV_NP = @HAVE_SIGABBREV_NP@ HAVE_SIGACTION = @HAVE_SIGACTION@ HAVE_SIGHANDLER_T = @HAVE_SIGHANDLER_T@ HAVE_SIGINFO_T = @HAVE_SIGINFO_T@ @@ -2843,6 +2845,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's/@''GNULIB_STRTOK_R''@/$(GNULIB_STRTOK_R)/g' \ -e 's/@''GNULIB_STRERROR''@/$(GNULIB_STRERROR)/g' \ -e 's/@''GNULIB_STRERROR_R''@/$(GNULIB_STRERROR_R)/g' \ + -e 's/@''GNULIB_SIGABBREV_NP''@/$(GNULIB_SIGABBREV_NP)/g' \ -e 's/@''GNULIB_STRSIGNAL''@/$(GNULIB_STRSIGNAL)/g' \ -e 's/@''GNULIB_STRVERSCMP''@/$(GNULIB_STRVERSCMP)/g' \ < $(srcdir)/string.in.h | \ @@ -2865,6 +2868,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''HAVE_STRCASESTR''@|$(HAVE_STRCASESTR)|g' \ -e 's|@''HAVE_DECL_STRTOK_R''@|$(HAVE_DECL_STRTOK_R)|g' \ -e 's|@''HAVE_DECL_STRERROR_R''@|$(HAVE_DECL_STRERROR_R)|g' \ + -e 's|@''HAVE_SIGABBREV_NP''@|$(HAVE_SIGABBREV_NP)|g' \ -e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \ -e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \ -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h index e4809b401f7..b5b63e53f12 100644 --- a/lib/stdalign.in.h +++ b/lib/stdalign.in.h @@ -54,10 +54,12 @@ #undef _Alignof /* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023 - <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */ + <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. + clang versions < 8.0.0 have the same bug. */ #if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ - && !defined __clang__)) + && !defined __clang__) \ + || (defined __clang__ && __clang_major__ < 8)) # ifdef __cplusplus # if 201103 <= __cplusplus # define _Alignof(type) alignof (type) diff --git a/lib/string.in.h b/lib/string.in.h index 7d83668f6ec..5134e11289d 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -1045,6 +1045,21 @@ _GL_WARN_ON_USE (strerror_r, "strerror_r is unportable - " # endif #endif +/* Return an abbreviation string for the signal number SIG. */ +#if @GNULIB_SIGABBREV_NP@ +# if ! @HAVE_SIGABBREV_NP@ +_GL_FUNCDECL_SYS (sigabbrev_np, const char *, (int sig)); +# endif +_GL_CXXALIAS_SYS (sigabbrev_np, const char *, (int sig)); +_GL_CXXALIASWARN (sigabbrev_np); +#elif defined GNULIB_POSIXCHECK +# undef sigabbrev_np +# if HAVE_RAW_DECL_SIGABBREV_NP +_GL_WARN_ON_USE (sigabbrev_np, "sigabbrev_np is unportable - " + "use gnulib module sigabbrev_np for portability"); +# endif +#endif + #if @GNULIB_STRSIGNAL@ # if @REPLACE_STRSIGNAL@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 125f9acc705..638d8c1f884 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -401,10 +401,10 @@ changes in daylight saving time are not taken into account." (when (decoded-time-year delta) (cl-incf (decoded-time-year time) (decoded-time-year delta))) - ;; Months are pretty simple. + ;; Months are pretty simple, but start at 1 (for January). (when (decoded-time-month delta) - (let ((new (+ (decoded-time-month time) (decoded-time-month delta)))) - (setf (decoded-time-month time) (mod new 12)) + (let ((new (+ (1- (decoded-time-month time)) (decoded-time-month delta)))) + (setf (decoded-time-month time) (1+ (mod new 12))) (cl-incf (decoded-time-year time) (/ new 12)))) ;; Adjust for month length (as described in the doc string). diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index a49f428a3c8..4f513d33865 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1937,11 +1937,13 @@ their associated keys and their effects." (find-file-noselect file 'nowarn) (set-window-buffer (selected-window) (set-buffer (find-buffer-visiting file))) - ;; If this command was invoked outside of a Todo mode buffer, - ;; the call to todo-current-category above returned nil. If - ;; we just entered Todo mode now, then cat was set to the - ;; file's first category, but if todo-mode was already - ;; enabled, cat did not get set, so we have to do that. + ;; If FILE is not in Todo mode, set it now, which also sets + ;; CAT to the file's first category. + (unless (derived-mode-p 'todo-mode) (todo-mode)) + ;; But if FILE was already in todo-mode and the item insertion + ;; command was invoked outside of a Todo mode buffer, the + ;; above calls to todo-current-category returned nil, so we + ;; have to explicitly set CAT to the current category. (unless cat (setq cat (todo-current-category))) (setq todo-current-todo-file file) @@ -2169,7 +2171,9 @@ the item at point." (if comment-delete (when (todo-y-or-n-p "Delete comment? ") (delete-region (match-beginning 0) (match-end 0))) - (replace-match (read-string prompt (cons (match-string 1) 1)) + (replace-match (save-match-data + (read-string prompt + (cons (match-string 1) 1))) nil nil nil 1)) (if comment-delete (user-error "There is no comment to delete") @@ -2348,25 +2352,35 @@ made in the number or names of categories." ((or (string= omonth "*") (= mm 13)) (user-error "Cannot increment *")) (t - (let ((mminc (+ mm inc (if (< inc 0) 12 0)))) - ;; Increment or decrement month by INC - ;; modulo 12. - (setq mm (% mminc 12)) - ;; If result is 0, make month December. - (setq mm (if (= mm 0) 12 (abs mm))) + (let* ((mmo mm) + ;; Change by 12 or more months? + (bigincp (>= (abs inc) 12)) + ;; Month number is in range 1..12. + (mminc (+ mm (% inc 12))) + (mm (% (+ mminc 12) 12)) + ;; 12n mod 12 = 0, so 0 is December. + (mm (if (= mm 0) 12 mm)) + ;; Does change in month cross year? + (mmcmp (cond ((< inc 0) (> mm mmo)) + ((> inc 0) (< mm mmo)))) + (yyadjust (if bigincp + (+ (abs (/ inc 12)) + (if mmcmp 1 0)) + 1))) ;; Adjust year if necessary. - (setq year (or (and (cond ((> mminc 12) - (+ yy (/ mminc 12))) - ((< mminc 1) - (- yy (/ mminc 12) 1)) - (t yy)) - (number-to-string yy)) - oyear))) - ;; Return the changed numerical month as - ;; a string or the corresponding month name. - (if omonth - (number-to-string mm) - (aref tma-array (1- mm)))))) + (setq yy (cond ((and (< inc 0) + (or mmcmp bigincp)) + (- yy yyadjust)) + ((and (> inc 0) + (or mmcmp bigincp)) + (+ yy yyadjust)) + (t yy))) + (setq year (number-to-string yy)) + ;; Return the changed numerical month as + ;; a string or the corresponding month name. + (if omonth + (number-to-string mm) + (aref tma-array (1- mm))))))) ;; Since the number corresponding to the arbitrary ;; month name "*" is out of the range of ;; calendar-last-day-of-month, set it to 1 @@ -5923,8 +5937,15 @@ categories from `todo-category-completions-files'." (todo-absolute-file-name (let ((files (mapcar #'todo-short-file-name catfil))) (completing-read (format str cat) files))))))) - ;; Default to the current file. - (unless file0 (setq file0 todo-current-todo-file)) + ;; When called without arg FILE, use fallback todo file. + (unless file0 (setq file0 (or todo-current-todo-file + ;; If we're outside of todo-mode + ;; but there is a current todo + ;; file, use it. + todo-global-current-todo-file + ;; Else, use the default todo file. + (todo-absolute-file-name + todo-default-todo-file)))) ;; First validate only a name passed interactively from ;; todo-add-category, which must be of a nonexistent category. (unless (and (assoc cat categories) (not add)) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 6632687da47..f5b70e082a5 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -98,6 +98,11 @@ (ctl-arrow display boolean) (truncate-lines display boolean) (word-wrap display boolean) + (word-wrap-by-category + display boolean "28.1" + :set (lambda (symbol value) + (set-default symbol value) + (when value (require 'kinsoku)))) (selective-display-ellipses display boolean) (indicate-empty-lines fringe boolean) (indicate-buffer-boundaries diff --git a/lisp/dired.el b/lisp/dired.el index 77bb6cfa9ca..94d3befda85 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -77,6 +77,27 @@ If nil, `dired-listing-switches' is used." :type '(choice (const :tag "Use dired-listing-switches" nil) (string :tag "Switches"))) +(defcustom dired-maybe-use-globstar nil + "If non-nil, enable globstar if the shell supports it. +Some shells enable this feature by default (e.g. zsh or fish). + +See `dired-enable-globstar-in-shell' for a list of shells +that support globstar and disable it by default. + +Note that the implementations of globstar have small differences +between shells. You must check your shell documentation to see +what to expect." + :type 'boolean + :group 'dired + :version "28.1") + +(defconst dired-enable-globstar-in-shell + '(("ksh" . "set -G") + ("bash" . "shopt -s globstar")) + "Alist of (SHELL . COMMAND), where COMMAND enables globstar in SHELL. +If `dired-maybe-use-globstar' is non-nil, then `dired-insert-directory' +checks this alist to enable globstar in the shell subprocess.") + (defcustom dired-chown-program (purecopy (cond ((executable-find "chown") "chown") ((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown") @@ -1470,6 +1491,13 @@ see `dired-use-ls-dired' for more details.") (executable-find explicit-shell-file-name)) (executable-find "sh"))) (switch (if remotep "-c" shell-command-switch))) + ;; Enable globstar + (when-let ((globstar dired-maybe-use-globstar) + (enable-it + (assoc-default + (file-truename sh) dired-enable-globstar-in-shell + (lambda (reg shell) (string-match reg shell))))) + (setq script (format "%s; %s" enable-it script))) (unless (zerop (process-file sh nil (current-buffer) nil switch script)) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 59e2e2e08ff..24c9e79f2c1 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -87,7 +87,10 @@ replacing its case-insensitive matches with the literal string in LIGHTER." If called interactively, enable %s if ARG is positive, and disable it if ARG is zero or negative. If called from Lisp, also enable the mode if ARG is omitted or nil, and toggle it -if ARG is `toggle'; disable the mode otherwise.") +if ARG is `toggle'; disable the mode otherwise. + +The mode's hook is called both when the mode is enabled and when +it is disabled.") (defun easy-mmode--mode-docstring (doc mode-pretty-name keymap-sym) (let ((doc (or doc (format "Toggle %s on or off. diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 29d3e30780f..f13d4dec014 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -138,6 +138,22 @@ (or (match-string 1 rrule) default-interval))) +(cl-defmethod gnus-icalendar-event:recurring-days ((event gnus-icalendar-event)) + "Return, when available, the week day numbers on which the EVENT recurs." + (let ((rrule (gnus-icalendar-event:recur event)) + (weekday-map '(("SU" . 0) + ("MO" . 1) + ("TU" . 2) + ("WE" . 3) + ("TH" . 4) + ("FR" . 5) + ("SA" . 6)))) + (when (string-match "BYDAY=\\([^;]+\\)" rrule) + (let ((bydays (split-string (match-string 1 rrule) ","))) + (seq-map + (lambda (x) (cdr (assoc x weekday-map))) + (seq-filter (lambda (x) (string-match "^[A-Z]\\{2\\}$" x)) bydays)))))) + (cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) @@ -401,21 +417,26 @@ Return nil for non-recurring EVENT." (when org-freq (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) -(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) - "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." - (let* ((start (gnus-icalendar-event:start-time event)) - (end (gnus-icalendar-event:end-time event)) - (start-date (format-time-string "%Y-%m-%d" start)) +(defun gnus-icalendar--find-day (start-date end-date day) + (let ((time-1-day 86400)) + (if (= (decoded-time-weekday (decode-time start-date)) + day) + (list start-date end-date) + (gnus-icalendar--find-day (time-add start-date time-1-day) + (time-add end-date time-1-day) + day)))) + +(defun gnus-icalendar-event--org-timestamp (start end org-repeat) + (let* ((start-date (format-time-string "%Y-%m-%d" start)) (start-time (format-time-string "%H:%M" start)) (start-at-midnight (string= start-time "00:00")) (end-date (format-time-string "%Y-%m-%d" end)) (end-time (format-time-string "%H:%M" end)) (end-at-midnight (string= end-time "00:00")) (start-end-date-diff - (time-to-number-of-days (time-subtract - (org-time-string-to-time end-date) - (org-time-string-to-time start-date)))) - (org-repeat (gnus-icalendar-event:org-repeat event)) + (time-to-number-of-days + (time-subtract (org-time-string-to-time end-date) + (org-time-string-to-time start-date)))) (repeat (if org-repeat (concat " " org-repeat) "")) (time-1-day 86400)) @@ -446,7 +467,31 @@ Return nil for non-recurring EVENT." ;; A .:. - A .:. -> A .:.-.:. ;; A .:. - B .:. ((zerop start-end-date-diff) (format "<%s %s-%s%s>" start-date start-time end-time repeat)) - (t (format "<%s %s>--<%s %s>" start-date start-time end-date end-time))))) + (t (format "<%s %s>--<%s %s>" start-date start-time end-date end-time)))) + ) + +(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event)) + "Build `org-mode' timestamp from EVENT start/end dates and recurrence info." + ;; if org-repeat +1d or +1w and byday: generate one timestamp per + ;; byday, starting at start-date. Change +1d to +7d. + (let ((start (gnus-icalendar-event:start-time event)) + (end (gnus-icalendar-event:end-time event)) + (org-repeat (gnus-icalendar-event:org-repeat event)) + (recurring-days (gnus-icalendar-event:recurring-days event))) + (if (and (or (string= org-repeat "+1d") + (string= org-repeat "+1w")) + recurring-days) + (let ((repeat "+1w") + (dates (seq-sort-by + 'car + 'time-less-p + (seq-map (lambda (x) + (gnus-icalendar--find-day start end x)) + recurring-days)))) + (mapconcat (lambda (x) + (gnus-icalendar-event--org-timestamp (car x) (cadr x) + repeat)) dates "\n")) + (gnus-icalendar-event--org-timestamp start end org-repeat)))) (defun gnus-icalendar--format-summary-line (summary &optional location) (if location @@ -757,7 +802,7 @@ These will be used to retrieve the RSVP information from ical events." `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle))))) (with-temp-buffer (mm-insert-part ,handle) - (when (string= (downcase ,charset) "utf-8") + (when (and ,charset (string= (downcase ,charset) "utf-8")) (decode-coding-region (point-min) (point-max) 'utf-8)) ,@body)))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 07ff4890385..e10322417d8 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -854,7 +854,8 @@ symbol `never', the posting is not allowed. If it is the symbol ;; differently (bug#36937). nil "Non-nil means don't add \"-f username\" to the sendmail command line. -Doing so would be even more evil than leaving it out." +See `feedmail-sendmail-f-doesnt-sell-me-out' for an explanation +of what the \"-f\" parameter does." :group 'message-sending :link '(custom-manual "(message)Mail Variables") :type 'boolean) @@ -4429,7 +4430,7 @@ conformance." (error "Invisible text found and made visible"))))) (message-check 'illegible-text (let (char found choice nul-chars) - (message-goto-body) + (goto-char (point-min)) (setq nul-chars (save-excursion (search-forward "\000" nil t))) (while (progn @@ -4465,11 +4466,12 @@ conformance." ,(format "Replace non-printable characters with \"%s\" and send" message-replacement-char)) + (?u "url-encode" "Use URL %hex encoding") (?s "send" "Send as is without removing anything") (?e "edit" "Continue editing"))))) (if (eq choice ?e) (error "Non-printable characters")) - (message-goto-body) + (goto-char (point-min)) (skip-chars-forward mm-7bit-chars) (while (not (eobp)) (when (let ((char (char-after))) @@ -4486,11 +4488,17 @@ conformance." control-1)) (not (get-text-property (point) 'untranslated-utf-8))))) - (if (eq choice ?i) - (message-kill-all-overlays) + (cond + ((eq choice ?i) + (message-kill-all-overlays)) + ((eq choice ?u) + (let ((char (get-byte (point)))) + (delete-char 1) + (insert (format "%%%x" char)))) + (t (delete-char 1) (when (eq choice ?r) - (insert message-replacement-char)))) + (insert message-replacement-char))))) (forward-char) (skip-chars-forward mm-7bit-chars))))) (message-check 'bogus-recipient @@ -4810,7 +4818,7 @@ If you always want Gnus to send messages in one piece, set message-courtesy-message))) ;; If this was set, `sendmail-program' takes care of encoding. (unless message-inhibit-body-encoding - ;; Let's make sure we encoded all the body. + ;; Let's make sure we encoded everything in the buffer. (cl-assert (save-excursion (goto-char (point-min)) (not (re-search-forward "[^\000-\377]" nil t))))) @@ -4844,6 +4852,7 @@ Each line should be no more than 79 characters long." (defvar smtpmail-smtp-server) (defvar smtpmail-smtp-service) (defvar smtpmail-smtp-user) +(defvar smtpmail-stream-type) (defun message-multi-smtp-send-mail () "Send the current buffer to `message-send-mail-function'. @@ -4862,6 +4871,11 @@ that instead." (let* ((smtpmail-smtp-server (nth 1 method)) (service (nth 2 method)) (port (string-to-number service)) + ;; If we're talking to the TLS SMTP port, then force a + ;; TLS connection. + (smtpmail-stream-type (if (= port 465) + 'tls + smtpmail-stream-type)) (smtpmail-smtp-service (if (> port 0) port service)) (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user))) (message-smtpmail-send-it))) @@ -6496,7 +6510,7 @@ When called without a prefix argument, header value spanning multiple lines is treated as a single line. Otherwise, even if N is 1, when point is on a continuation header line, it will be moved to the beginning " - (interactive "p") + (interactive "^p") (cond ;; Go to beginning of header or beginning of line. ((and message-beginning-of-line (message-point-in-header-p)) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 36b67a8fd13..81431270d7c 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -353,6 +353,7 @@ from the document.") (setq nndoc-dissection-alist nil) (with-current-buffer nndoc-current-buffer (erase-buffer) + (set-buffer-multibyte nil) (condition-case error (if (and (stringp nndoc-address) (string-match nndoc-binary-file-names nndoc-address)) diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index dead1f6bf77..e184c782640 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -162,6 +162,10 @@ included in this list. Suggested properties are `keymap', `local-map', `button' and `kbd-help'. Any value other than t or a non-empty list disables the feature. +The text printed from the `help-echo' property is often only +relevant when using the mouse. The presence of a `kbd-help' +property guarantees that non mouse specific help is available. + This variable only takes effect after a call to `help-at-pt-set-timer'. The help gets printed after Emacs has been idle for `help-at-pt-timer-delay' seconds. You can call diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 948e62e10d0..4c719f7cda2 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -612,6 +612,15 @@ Key bindings: (setq major-mode 'image-mode) (setq image-transform-resize image-auto-resize) + ;; Bail out early if we have no image data. + (if (zerop (buffer-size)) + (funcall (if (called-interactively-p 'any) 'error 'message) + (if (file-exists-p buffer-file-name) + "Empty file" + "(New file)")) + (image-mode--display))) + +(defun image-mode--display () (if (not (image-get-display-property)) (progn (when (condition-case err diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el index ee1dc845fb5..c31a3b8d3cf 100644 --- a/lisp/image/image-converter.el +++ b/lisp/image/image-converter.el @@ -33,8 +33,15 @@ "Type of the external image converter to use. The value should a symbol, either `imagemagick', `graphicsmagick', or `ffmpeg'. + If nil, Emacs will try to find one of the supported converters -installed on the system." +installed on the system. + +The actual range of image formats that will be converted depends +on what image formats the chosen converter reports being able to +handle. `auto-mode-alist' is then used to further filter what +formats that are to be supported: Only the suffixes that map to +`image-mode' will be handled." :group 'image :type 'symbol :version "27.1") @@ -186,12 +193,25 @@ data is returned as a string." "Find an installed image converter." (catch 'done (dolist (elem image-converter--converters) - (when-let ((formats (image-converter--probe (car elem)))) + (when-let ((formats (image-converter--filter-formats + (image-converter--probe (car elem))))) (setq image-converter (car elem) image-converter-regexp (concat "\\." (regexp-opt formats) "\\'") image-converter-file-name-extensions formats) (throw 'done image-converter))))) +(defun image-converter--filter-formats (suffixes) + "Filter SUFFIXES based on `auto-mode-alist'. +Only suffixes that map to `image-mode' are returned." + (cl-loop with case-fold-search = (if (not auto-mode-case-fold) + nil + t) + for suffix in suffixes + when (eq (cdr (assoc (concat "foo." suffix) auto-mode-alist + #'string-match)) + 'image-mode) + collect suffix)) + (cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source image-format) "Convert using GraphicsMagick." diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index d3ae23c2f70..3b3fcf4c041 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -196,7 +196,9 @@ "Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and increment it. If IC is specified, embed DATA at IC." (if ic - (aset ccl-program-vector ic (ccl-fixnum data)) + (aset ccl-program-vector ic (if (numberp data) + (ccl-fixnum data) + data)) (let ((len (length ccl-program-vector))) (if (>= ccl-current-ic len) (let ((new (make-vector (* len 2) nil))) @@ -204,7 +206,9 @@ increment it. If IC is specified, embed DATA at IC." (setq len (1- len)) (aset new len (aref ccl-program-vector len))) (setq ccl-program-vector new)))) - (aset ccl-program-vector ccl-current-ic (ccl-fixnum data)) + (aset ccl-program-vector ccl-current-ic (if (numberp data) + (ccl-fixnum data) + data)) (setq ccl-current-ic (1+ ccl-current-ic)))) (defun ccl-embed-symbol (symbol prop) diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el index 54bf0e95313..4e9b6b015a5 100644 --- a/lisp/international/kinsoku.el +++ b/lisp/international/kinsoku.el @@ -182,4 +182,6 @@ the context of text formatting." (aref (char-category-set (preceding-char)) ?<)) (kinsoku-shorter linebeg)))) +(provide 'kinsoku) + ;;; kinsoku.el ends here diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 8e2039ba9d8..c385fdfc265 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -355,6 +355,18 @@ This is a helper function for `mouse-wheel-mode'." (when (memq (lookup-key (current-global-map) key) funs) (global-unset-key key)))) +(defun mouse-wheel--create-scroll-keys (binding event) + "Return list of key vectors for BINDING and EVENT. +BINDING is an element in `mouse-wheel-scroll-amount'. EVENT is +an event used for scrolling, such as `mouse-wheel-down-event'." + (let ((prefixes (list 'left-margin 'right-margin + 'left-fringe 'right-fringe + 'vertical-scroll-bar 'horizontal-scroll-bar + 'mode-line 'header-line))) + (cons (vector event) ; default case: no prefix. + (when (not (consp binding)) + (mapcar (lambda (prefix) (vector prefix event)) prefixes))))) + (define-minor-mode mouse-wheel-mode "Toggle mouse wheel support (Mouse Wheel mode)." :init-value t @@ -379,14 +391,16 @@ This is a helper function for `mouse-wheel-mode'." ;; Bindings for changing font size. ((and (consp binding) (eq (cdr binding) 'text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event)) + ;; Add binding. (let ((key `[,(list (caar binding) event)])) (global-set-key key 'mouse-wheel-text-scale) (push key mwheel-installed-text-scale-bindings)))) ;; Bindings for scrolling. (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-right-event mouse-wheel-left-event)) - (let ((key `[(,@(if (consp binding) (car binding)) ,event)])) + mouse-wheel-left-event mouse-wheel-right-event)) + (dolist (key (mouse-wheel--create-scroll-keys binding event)) + ;; Add binding. (global-set-key key 'mwheel-scroll) (push key mwheel-installed-bindings)))))))) diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 9436f45aa32..43bea76a6bc 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -280,6 +280,16 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and (widen) (goto-address-unfontify (point-min) (point-max))))) +(defun goto-addr-mode--turn-on () + (when (not goto-address-mode) + (goto-address-mode 1))) + +;;;###autoload +(define-globalized-minor-mode global-goto-address-mode + goto-address-mode goto-addr-mode--turn-on + :group 'goto-address + :version "28.1") + ;;;###autoload (define-minor-mode goto-address-prog-mode "Like `goto-address-mode', but only for comments and strings." diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index 098aa3d5fe1..d7c5b381d29 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -118,7 +118,7 @@ Return the new list." (goto-char (point-min)) (while (re-search-forward - "^\\s-*\\([^\n#%.$][^:=\n]*\\)\\s-*:[^=]" nil t) + "^\\([^\t\n#%.$][^:=\n]*\\)\\s-*:[^=]" nil t) (setq targets (nconc (split-string (match-string-no-properties 1)) targets))) targets) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 2d2713a36ab..c47aa2ea8c2 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -451,8 +451,7 @@ Older version of this page was called `perl5', newer `perl'." :type 'string :group 'cperl-help-system) -(defcustom cperl-use-syntax-table-text-property - (boundp 'parse-sexp-lookup-properties) +(defcustom cperl-use-syntax-table-text-property t "Non-nil means CPerl sets up and uses `syntax-table' text property." :type 'boolean :group 'cperl-speed) @@ -535,8 +534,7 @@ One should tune up `cperl-close-paren-offset' as well." :type 'boolean :group 'cperl-indentation-details) -(defcustom cperl-syntaxify-by-font-lock - (boundp 'parse-sexp-lookup-properties) +(defcustom cperl-syntaxify-by-font-lock t "Non-nil means that CPerl uses the `font-lock' routines for syntaxification." :type '(choice (const message) boolean) :group 'cperl-speed) @@ -1081,10 +1079,6 @@ versions of Emacs." (define-key map [(control ?c) (control ?h) ?v] ;;(concat (char-to-string help-char) "v") ; does not work 'cperl-get-help)) - (or (boundp 'fill-paragraph-function) - (substitute-key-definition - 'fill-paragraph 'cperl-fill-paragraph - map global-map)) (substitute-key-definition 'indent-sexp 'cperl-indent-exp map global-map) @@ -1637,9 +1631,8 @@ or as help on variables `cperl-tips', `cperl-problems', "\\)" cperl-maybe-white-and-comment-rex)) (set (make-local-variable 'comment-indent-function) #'cperl-comment-indent) - (and (boundp 'fill-paragraph-function) - (set (make-local-variable 'fill-paragraph-function) - #'cperl-fill-paragraph)) + (set (make-local-variable 'fill-paragraph-function) + #'cperl-fill-paragraph) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'indent-region-function) #'cperl-indent-region) ;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off! @@ -1701,13 +1694,8 @@ or as help on variables `cperl-tips', `cperl-problems', ;; to make font-lock think that font-lock-syntactic-keywords ;; are defined. '(t))))) - (if (boundp 'font-lock-multiline) ; Newer font-lock; use its facilities - (progn - (setq cperl-font-lock-multiline t) ; Not localized... - (set (make-local-variable 'font-lock-multiline) t)) - (set (make-local-variable 'font-lock-fontify-region-function) - ;; not present with old Emacs - #'cperl-font-lock-fontify-region-function)) + (setq cperl-font-lock-multiline t) ; Not localized... + (set (make-local-variable 'font-lock-multiline) t) (set (make-local-variable 'font-lock-fontify-region-function) #'cperl-font-lock-fontify-region-function) (make-local-variable 'cperl-old-style) @@ -5451,8 +5439,7 @@ indentation and initial hashes. Behaves usually outside of comment." (cond ((featurep 'ps-print) (or cperl-faces-init (progn - (and (boundp 'font-lock-multiline) - (setq cperl-font-lock-multiline t)) + (setq cperl-font-lock-multiline t) (cperl-init-faces)))) ((not cperl-faces-init) (add-hook 'font-lock-mode-hook @@ -5499,12 +5486,8 @@ indentation and initial hashes. Behaves usually outside of comment." (condition-case errs (progn (require 'font-lock) - (and (fboundp 'font-lock-fontify-anchored-keywords) - (featurep 'font-lock-extra) - (message "You have an obsolete package `font-lock-extra'. Install `choose-color'.")) (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored) - (if (fboundp 'font-lock-fontify-anchored-keywords) - (setq font-lock-anchored t)) + (setq font-lock-anchored t) (setq t-font-lock-keywords (list @@ -6857,7 +6840,7 @@ Use as (insert (cperl-find-tags file xs topdir)))))) (if inbuffer nil ; Delegate to the caller (save-buffer 0) ; No backup - (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs? + (if (fboundp 'initialize-new-tags-table) (initialize-new-tags-table)))))) (defvar cperl-tags-hier-regexp-list diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 7731be59659..c71a90344ff 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -168,8 +168,14 @@ This is done to disambiguate file names in `grep's output." "The default find command for \\[grep-find]. In interactive usage, the actual value of this variable is set up by `grep-compute-defaults'; to change the default value, use -\\[customize] or call the function `grep-apply-setting'." +\\[customize] or call the function `grep-apply-setting'. + +This variable can either be a string, or a cons of the +form (COMMAND . POSITION). In the latter case, COMMAND will be +used as the default command, and point will be placed at POSITION +for easier editing." :type '(choice string + (cons string integer) (const :tag "Not Set" nil)) :set #'grep-apply-setting) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 625e08e4d79..c5b9cfc2e7b 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -225,6 +225,8 @@ ;;--------------------------------------------------------------------------- ;; user-configurable variables +(require 'cl-lib) + (defgroup hideshow nil "Minor mode for hiding and showing program and comment blocks." :prefix "hs-" @@ -652,7 +654,9 @@ Otherwise, guess start, end and `comment-start' regexps; `forward-sexp' function; and adjust-block-beginning function." (if (and (bound-and-true-p comment-start) (bound-and-true-p comment-end)) - (let* ((lookup (assoc major-mode hs-special-modes-alist)) + (let* ((lookup (cl-assoc-if (lambda (mode) + (derived-mode-p major-mode mode)) + hs-special-modes-alist)) (start-elem (or (nth 1 lookup) "\\s("))) (if (listp start-elem) ;; handle (START-REGEXP MDATA-SELECT) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index e16225c7fa9..831acf87bf0 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1060,22 +1060,12 @@ delimiter." (goto-char (point)) ) ((looking-at "[\\[{(]") - (let ((deep (ruby-deep-indent-paren-p (char-after)))) - (if (and deep (or (not (eq (char-after) ?\{)) (ruby-expr-beg))) - (progn - (and (eq deep 'space) (looking-at ".\\s +[^# \t\n]") - (setq pnt (1- (match-end 0)))) - (setq nest (cons (cons (char-after (point)) pnt) nest)) - (setq pcol (cons (cons pnt depth) pcol)) - (setq depth 0)) - (setq nest (cons (cons (char-after (point)) pnt) nest)) - (setq depth (1+ depth)))) + (setq nest (cons (cons (char-after (point)) pnt) nest)) + (setq depth (1+ depth)) (goto-char pnt) ) ((looking-at "[])}]") - (if (ruby-deep-indent-paren-p (matching-paren (char-after))) - (setq depth (cdr (car pcol)) pcol (cdr pcol)) - (setq depth (1- depth))) + (setq depth (1- depth)) (setq nest (cdr nest)) (goto-char pnt)) ((looking-at ruby-block-end-re) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 3c9ced02916..8bde89e774e 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -1,4 +1,4 @@ -;;; vera-mode.el --- major mode for editing Vera files +;;; vera-mode.el --- major mode for editing Vera files -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2020 Free Software Foundation, Inc. @@ -33,9 +33,7 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This package provides a simple Emacs major mode for editing Vera code. ;; It includes the following features: @@ -44,38 +42,11 @@ ;; - Indentation ;; - Word/keyword completion ;; - Block commenting -;; - Works under GNU Emacs and XEmacs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Documentation ;; See comment string of function `vera-mode' or type `C-h m' in Emacs. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Installation - -;; Prerequisites: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X - -;; Put `vera-mode.el' into the `site-lisp' directory of your Emacs installation -;; or into an arbitrary directory that is added to the load path by the -;; following line in your Emacs start-up file (`.emacs'): - -;; (setq load-path (cons (expand-file-name "<directory-name>") load-path)) - -;; If you already have the compiled `vera-mode.elc' file, put it in the same -;; directory. Otherwise, byte-compile the source file: -;; Emacs: M-x byte-compile-file -> vera-mode.el -;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vera-mode.el - -;; Add the following lines to the `site-start.el' file in the `site-lisp' -;; directory of your Emacs installation or to your Emacs start-up file -;; (`.emacs'): - -;; (autoload 'vera-mode "vera-mode" "Vera Mode" t) -;; (setq auto-mode-alist (cons '("\\.vr[hi]?\\'" . vera-mode) auto-mode-alist)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -90,16 +61,14 @@ (defcustom vera-basic-offset 2 "Amount of basic offset used for indentation." - :type 'integer - :group 'vera) + :type 'integer) (defcustom vera-underscore-is-part-of-word nil "Non-nil means consider the underscore character `_' as part of word. An identifier containing underscores is then treated as a single word in select and move operations. All parts of an identifier separated by underscore are treated as single words otherwise." - :type 'boolean - :group 'vera) + :type 'boolean) (make-obsolete-variable 'vera-underscore-is-part-of-word 'superword-mode "24.4") @@ -110,8 +79,7 @@ else if not at beginning of line then insert tab, else if last command was a `TAB' or `RET' then dedent one step, else indent current line. If nil, TAB always indents current line." - :type 'boolean - :group 'vera) + :type 'boolean) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -125,9 +93,6 @@ If nil, TAB always indents current line." (let ((map (make-sparse-keymap))) ;; Backspace/delete key bindings. (define-key map [backspace] 'backward-delete-char-untabify) - (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable - (define-key map [delete] 'delete-char) - (define-key map [(meta delete)] 'kill-word)) ;; Standard key bindings. (define-key map "\M-e" 'vera-forward-statement) (define-key map "\M-a" 'vera-backward-statement) @@ -227,9 +192,7 @@ If nil, TAB always indents current line." (modify-syntax-entry ?\{ "(}" syntax-table) (modify-syntax-entry ?\} "){" syntax-table) ;; comment - (if (featurep 'xemacs) - (modify-syntax-entry ?\/ ". 1456" syntax-table) ; XEmacs - (modify-syntax-entry ?\/ ". 124b" syntax-table)) ; Emacs + (modify-syntax-entry ?\/ ". 124b" syntax-table) (modify-syntax-entry ?\* ". 23" syntax-table) ;; newline and CR (modify-syntax-entry ?\n "> b" syntax-table) @@ -314,8 +277,6 @@ Key bindings: ;; initialize font locking (set (make-local-variable 'font-lock-defaults) '(vera-font-lock-keywords nil nil ((?\_ . "w")))) - ;; add menu (XEmacs) - (easy-menu-add vera-mode-menu) ;; miscellaneous (message "Vera Mode %s. Type C-c C-h for documentation." vera-version)) @@ -542,12 +503,6 @@ Key bindings: ) "List of Vera-RVM predefined constants.") -;; `regexp-opt' undefined (`xemacs-devel' not installed) -(unless (fboundp 'regexp-opt) - (defun regexp-opt (strings &optional paren) - (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) - (concat open (mapconcat 'regexp-quote strings "\\|") close)))) - (defconst vera-keywords-regexp (concat "\\<\\(" (regexp-opt vera-keywords) "\\)\\>") "Regexp for Vera keywords.") @@ -796,10 +751,7 @@ This function does not modify point or mark." (defun vera-skip-forward-literal () "Skip forward literal and return t if within one." - (let ((state (save-excursion - (if (fboundp 'syntax-ppss) - (syntax-ppss) - (parse-partial-sexp (point-min) (point)))))) + (let ((state (save-excursion (syntax-ppss)))) (when (nth 8 state) ;; Inside a string or comment. (goto-char (nth 8 state)) @@ -814,10 +766,7 @@ This function does not modify point or mark." (defun vera-skip-backward-literal () "Skip backward literal and return t if within one." - (let ((state (save-excursion - (if (fboundp 'syntax-ppss) - (syntax-ppss) - (parse-partial-sexp (point-min) (point)))))) + (let ((state (save-excursion (syntax-ppss)))) (when (nth 8 state) ;; Inside a string or comment. (goto-char (nth 8 state)) @@ -1232,6 +1181,8 @@ Calls `indent-region' for whole buffer." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; electrifications +(defvar hippie-expand-only-buffers) + (defun vera-electric-tab (&optional prefix) "Do what I mean (indent, expand, tab, change indent, etc..). If preceding character is part of a word or a paren then `hippie-expand', @@ -1243,7 +1194,7 @@ If `vera-intelligent-tab' is nil, always indent line." (interactive "*P") (if vera-intelligent-tab (progn - (cond ((and (not (featurep 'xemacs)) (use-region-p)) + (cond ((use-region-p) (vera-indent-region (region-beginning) (region-end) nil)) ((memq (char-syntax (preceding-char)) '(?w ?_)) (let ((case-fold-search t) diff --git a/lisp/simple.el b/lisp/simple.el index f08015372af..fa6e154004b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2416,15 +2416,17 @@ previous element of the minibuffer history in the minibuffer." (goto-char (1- (minibuffer-prompt-end))) (current-column)))) (move-to-column old-column)) - ;; Put the cursor at the end of the visual line instead of the - ;; logical line, so the next `previous-line-or-history-element' - ;; would move to the previous history element, not to a possible upper - ;; visual line from the end of logical line in `line-move-visual' mode. - (end-of-visual-line) - ;; Since `end-of-visual-line' puts the cursor at the beginning - ;; of the next visual line, move it one char back to the end - ;; of the first visual line (bug#22544). - (unless (eolp) (backward-char 1))))))) + (if (not line-move-visual) ; Handle logical lines (bug#42862) + (end-of-line) + ;; Put the cursor at the end of the visual line instead of the + ;; logical line, so the next `previous-line-or-history-element' + ;; would move to the previous history element, not to a possible upper + ;; visual line from the end of logical line in `line-move-visual' mode. + (end-of-visual-line) + ;; Since `end-of-visual-line' puts the cursor at the beginning + ;; of the next visual line, move it one char back to the end + ;; of the first visual line (bug#22544). + (unless (eolp) (backward-char 1)))))))) (defun next-complete-history-element (n) "Get next history element that completes the minibuffer before the point. @@ -7019,15 +7021,16 @@ rests." (setq done t))))))) (defun move-beginning-of-line (arg) - "Move point to beginning of current line as displayed. -\(If there's an image in the line, this disregards newlines -that are part of the text that the image rests on.) + "Move point to visible beginning of current logical line. +This disregards any invisible newline characters. With argument ARG not nil or 1, move forward ARG - 1 lines first. If point reaches the beginning or end of buffer, it stops there. \(But if the buffer doesn't end in a newline, it stops at the beginning of the last line.) -To ignore intangibility, bind `inhibit-point-motion-hooks' to t." + +To ignore intangibility, bind `inhibit-point-motion-hooks' to t. +For motion by visual lines, see `beginning-of-visual-line'." (interactive "^p") (or arg (setq arg 1)) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index b2ccbc8da24..8252da604eb 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -4188,7 +4188,7 @@ Both should not be used to define a buffer-local dictionary." (let (line-okay search done found) (while (not done) (let ((case-fold-search nil)) - (setq search (search-forward ispell-words-keyword nil 'move) + (setq search (search-forward ispell-words-keyword nil t) found (or found search) line-okay (< (+ (length word) 1 ; 1 for space after word.. (progn (end-of-line) (current-column))) @@ -4199,8 +4199,10 @@ Both should not be used to define a buffer-local dictionary." (setq done t) (if (null search) (progn - (open-line 1) - (unless found (newline)) + (if found (insert "\n") ;; after an existing LocalWords + (goto-char (point-max)) ;; no LocalWords, go to end of file + (open-line 1) + (newline)) (insert (if comment-start (concat (progn diff --git a/lisp/time.el b/lisp/time.el index 96b49ddabdd..1ab992adb45 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -421,8 +421,6 @@ runs the normal hook `display-time-hook' after each update." #'world-clock-mode "28.1") (define-obsolete-function-alias 'display-time-world-display #'world-clock-display "28.1") -(define-obsolete-function-alias 'display-time-world - #'world-clock "28.1") (define-obsolete-function-alias 'display-time-world-timer #'world-clock-update "28.1") @@ -522,7 +520,7 @@ If the value is t instead of an alist, use the value of (define-derived-mode world-clock-mode special-mode "World clock" "Major mode for buffer that displays times in various time zones. See `world-clock'." - (setq revert-buffer-function #'world-clock-update) + (setq-local revert-buffer-function #'world-clock-update) (setq show-trailing-whitespace nil)) (defun world-clock-display (alist) @@ -551,6 +549,10 @@ See `world-clock'." (delete-char -1)) (goto-char (point-min))) +;; Old name -- preserved for backwards compatibility. +;;;###autoload +(defalias 'display-time-world #'world-clock) + ;;;###autoload (defun world-clock () "Display a world clock buffer with times in various time zones. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index bd5ac9b9a62..9c41d508b6b 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -392,6 +392,12 @@ well." '((t :inherit diff-file-header)) "`diff-mode' face used to highlight nonexistent files in recursive diffs.") +(defface diff-error + '((((class color)) + :foreground "red" :background "black" :weight bold) + (t :weight bold)) + "`diff-mode' face for error messages from diff.") + (defconst diff-yank-handler '(diff-yank-function)) (defun diff-yank-function (text) ;; FIXME: the yank-handler is now called separately on each piece of text @@ -472,6 +478,7 @@ and the face `diff-added' for added lines.") ("^\\(#\\)\\(.*\\)" (1 font-lock-comment-delimiter-face) (2 font-lock-comment-face)) + ("^diff: .*" (0 'diff-error)) ("^[^-=+*!<>#].*\n" (0 'diff-context)) (,#'diff--font-lock-syntax) (,#'diff--font-lock-prettify) @@ -1988,8 +1995,7 @@ revision of the file otherwise." (diff-find-source-location other-file reverse))) (pop-to-buffer buf) (goto-char (+ (car pos) (cdr src))) - (when buffer (next-error-found buffer (current-buffer))) - (diff-hunk-status-msg line-offset (xor reverse switched) t)))) + (when buffer (next-error-found buffer (current-buffer)))))) (defun diff-current-defun () diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index ef466741b24..ccf5a7807f2 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -325,6 +325,10 @@ one optional arguments, diff-number to refine.") (error-buf ediff-error-buffer)) (ediff-skip-unsuitable-frames) (switch-to-buffer error-buf) + ;; We output data from the diff command using `raw-text' as + ;; the coding system, so decode before displaying. + (when (eq ediff-coding-system-for-read 'raw-text) + (decode-coding-region (point-min) (point-max) 'undecided)) (ediff-kill-buffer-carefully ctl-buf) (user-error "Errors in diff output. Diff output is in %S" diff-buff)))) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index e8231ecb289..fdbf44e0f13 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -337,32 +337,35 @@ its parents." (directory-file-name dir)))) (eq dir t))) +(declare-function log-edit-extract-headers "log-edit" (headers string)) + (defun vc-cvs-checkin (files comment &optional rev) "CVS-specific version of `vc-backend-checkin'." - (unless (or (not rev) (vc-cvs-valid-revision-number-p rev)) - (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) + (unless (or (not rev) (vc-cvs-valid-revision-number-p rev)) + (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) (error "%s is not a valid symbolic tag name" rev) - ;; If the input revision is a valid symbolic tag name, we create it - ;; as a branch, commit and switch to it. - (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev)) - (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev)) - (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev)) + ;; If the input revision is a valid symbolic tag name, we create it + ;; as a branch, commit and switch to it. + (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev)) + (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev)) + (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev)) files))) - (let ((status (apply 'vc-cvs-command nil 1 files - "ci" (if rev (concat "-r" rev)) - (concat "-m" comment) - (vc-switches 'CVS 'checkin)))) + (let ((status (apply + 'vc-cvs-command nil 1 files + "ci" (if rev (concat "-r" rev)) + (concat "-m" (car (log-edit-extract-headers nil comment))) + (vc-switches 'CVS 'checkin)))) (set-buffer "*vc*") (goto-char (point-min)) (when (not (zerop status)) ;; Check checkin problem. (cond ((re-search-forward "Up-to-date check failed" nil t) - (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) + (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) files) (error "%s" (substitute-command-keys - (concat "Up-to-date check failed: " - "type \\[vc-next-action] to merge in changes")))) + (concat "Up-to-date check failed: " + "type \\[vc-next-action] to merge in changes")))) (t (pop-to-buffer (current-buffer)) (goto-char (point-min)) @@ -372,7 +375,7 @@ its parents." ;; Otherwise we can't necessarily tell what goes with what; clear ;; its properties so they have to be refetched. (if (= (length files) 1) - (vc-file-setprop + (vc-file-setprop (car files) 'vc-working-revision (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) (mapc 'vc-file-clearprops files)) @@ -385,7 +388,7 @@ its parents." ;; if this was an explicit check-in (does not include creation of ;; a branch), remove the sticky tag. (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev))) - (vc-cvs-command nil 0 files "update" "-A")))) + (vc-cvs-command nil 0 files "update" "-A")))) (defun vc-cvs-find-revision (file rev buffer) (apply 'vc-cvs-command diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4 index c1ec624b3b3..db833d820f3 100644 --- a/m4/std-gnu11.m4 +++ b/m4/std-gnu11.m4 @@ -70,7 +70,7 @@ _AS_ECHO_LOG([checking for _AC_LANG compiler version]) set X $ac_compile ac_compiler=$[2] for ac_option in --version -v -V -qversion -version; do - m4_ifdef([_AC_DO_LIMIT],[_AC_DO_LIMIT],[_AC_DO])([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD]) + _AC_DO_LIMIT([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD]) done m4_expand_once([_AC_COMPILER_EXEEXT])[]dnl @@ -135,7 +135,7 @@ _AS_ECHO_LOG([checking for _AC_LANG compiler version]) set X $ac_compile ac_compiler=$[2] for ac_option in --version -v -V -qversion; do - m4_ifdef([_AC_DO_LIMIT],[_AC_DO_LIMIT],[_AC_DO])([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD]) + _AC_DO_LIMIT([$ac_compiler $ac_option >&AS_MESSAGE_LOG_FD]) done m4_expand_once([_AC_COMPILER_EXEEXT])[]dnl diff --git a/m4/string_h.m4 b/m4/string_h.m4 index 516b346b311..d519beaa591 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 24 +# serial 25 # Written by Paul Eggert. @@ -28,7 +28,7 @@ AC_DEFUN([gl_HEADER_STRING_H_BODY], ]], [ffsl ffsll memmem mempcpy memrchr rawmemchr stpcpy stpncpy strchrnul strdup strncat strndup strnlen strpbrk strsep strcasestr strtok_r - strerror_r strsignal strverscmp]) + strerror_r sigabbrev_np strsignal strverscmp]) AC_REQUIRE([AC_C_RESTRICT]) ]) @@ -80,6 +80,7 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS], GNULIB_MBSTOK_R=0; AC_SUBST([GNULIB_MBSTOK_R]) GNULIB_STRERROR=0; AC_SUBST([GNULIB_STRERROR]) GNULIB_STRERROR_R=0; AC_SUBST([GNULIB_STRERROR_R]) + GNULIB_SIGABBREV_NP=0;AC_SUBST([GNULIB_SIGABBREV_NP]) GNULIB_STRSIGNAL=0; AC_SUBST([GNULIB_STRSIGNAL]) GNULIB_STRVERSCMP=0; AC_SUBST([GNULIB_STRVERSCMP]) HAVE_MBSLEN=0; AC_SUBST([HAVE_MBSLEN]) @@ -102,6 +103,7 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS], HAVE_STRCASESTR=1; AC_SUBST([HAVE_STRCASESTR]) HAVE_DECL_STRTOK_R=1; AC_SUBST([HAVE_DECL_STRTOK_R]) HAVE_DECL_STRERROR_R=1; AC_SUBST([HAVE_DECL_STRERROR_R]) + HAVE_SIGABBREV_NP=1; AC_SUBST([HAVE_SIGABBREV_NP]) HAVE_DECL_STRSIGNAL=1; AC_SUBST([HAVE_DECL_STRSIGNAL]) HAVE_STRVERSCMP=1; AC_SUBST([HAVE_STRVERSCMP]) REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR]) diff --git a/src/callproc.c b/src/callproc.c index 65c858393a9..e3346e2eabb 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -231,6 +231,9 @@ DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that case, Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. Remaining arguments ARGS are strings passed as command arguments to PROGRAM. +If PROGRAM is not an absolute file name, `call-process' will look for +PROGRAM in `exec-path' (which is a list of directories). + If executable PROGRAM can't be found as an executable, `call-process' signals a Lisp error. `call-process' reports errors in execution of the program only through its return and output. @@ -1060,6 +1063,9 @@ Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted. Remaining arguments ARGS are passed to PROGRAM at startup as command-line arguments. +If PROGRAM is not an absolute file name, `call-process-region' will +look for PROGRAM in `exec-path' (which is a list of directories). + If BUFFER is 0, `call-process-region' returns immediately with value nil. Otherwise it waits for PROGRAM to terminate and returns a numeric exit status or a signal description string. diff --git a/src/ccl.c b/src/ccl.c index 86debeef0e5..796698eb1ce 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -1374,7 +1374,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size if (! (IN_INT_RANGE (eop) && CHARACTERP (opl))) CCL_INVALID_CMD; reg[RRR] = charset_unicode; - reg[rrr] = eop; + reg[rrr] = XFIXNUM (opl); reg[7] = 1; /* r7 true for success */ } else diff --git a/src/editfns.c b/src/editfns.c index cb09ea8a31a..949f3825a3c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -707,7 +707,8 @@ If the scan reaches the end of the buffer, return that position. This function ignores text display directionality; it returns the position of the first character in logical order, i.e. the smallest -character position on the line. +character position on the logical line. See `vertical-motion' for +movement by screen lines. This function constrains the returned position to the current field unless that position would be on a different line from the original, diff --git a/src/image.c b/src/image.c index 643b3d0a1f4..123de54ba27 100644 --- a/src/image.c +++ b/src/image.c @@ -1633,7 +1633,7 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash) for (img = c->buckets[i]; img; img = img->next) if (img->hash == hash - && !equal_lists (img->spec, spec) + && equal_lists (img->spec, spec) && img->frame_foreground == FRAME_FOREGROUND_PIXEL (f) && img->frame_background == FRAME_BACKGROUND_PIXEL (f)) break; diff --git a/src/minibuf.c b/src/minibuf.c index e18ff17abbf..f957b2ae173 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1039,7 +1039,7 @@ Prompt with PROMPT. */) DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 2, 0, doc: /* Read the name of a user option and return it as a symbol. Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element -if it is a list. +if it is a list of strings. A user option, or customizable variable, is one for which `custom-variable-p' returns non-nil. */) (Lisp_Object prompt, Lisp_Object default_value) diff --git a/src/nsfns.m b/src/nsfns.m index 628233ea0dd..c7956497c4c 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -390,37 +390,25 @@ ns_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) /* Don't change the name if it's already NAME. */ if ([[view window] miniwindowTitle] && ([[[view window] miniwindowTitle] - isEqualToString: [NSString stringWithUTF8String: - SSDATA (arg)]])) + isEqualToString: [NSString stringWithLispString:arg]])) return; [[view window] setMiniwindowTitle: - [NSString stringWithUTF8String: SSDATA (arg)]]; + [NSString stringWithLispString:arg]]; } static void ns_set_name_internal (struct frame *f, Lisp_Object name) { - Lisp_Object encoded_name, encoded_icon_name; - NSString *str; NSView *view = FRAME_NS_VIEW (f); - - - encoded_name = ENCODE_UTF_8 (name); - - str = [NSString stringWithUTF8String: SSDATA (encoded_name)]; - + NSString *str = [NSString stringWithLispString: name]; /* Don't change the name if it's already NAME. */ if (! [[[view window] title] isEqualToString: str]) [[view window] setTitle: str]; - if (!STRINGP (f->icon_name)) - encoded_icon_name = encoded_name; - else - encoded_icon_name = ENCODE_UTF_8 (f->icon_name); - - str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)]; + if (STRINGP (f->icon_name)) + str = [NSString stringWithLispString: f->icon_name]; if ([[view window] miniwindowTitle] && ! [[[view window] miniwindowTitle] isEqualToString: str]) @@ -448,7 +436,7 @@ ns_set_name (struct frame *f, Lisp_Object name, int explicit) return; if (NILP (name)) - name = build_string ([ns_app_name UTF8String]); + name = [ns_app_name lispString]; else CHECK_STRING (name); @@ -487,7 +475,7 @@ ns_set_represented_filename (struct frame *f) { encoded_filename = ENCODE_UTF_8 (filename); - fstr = [NSString stringWithUTF8String: SSDATA (encoded_filename)]; + fstr = [NSString stringWithLispString:encoded_filename]; if (fstr == nil) fstr = @""; } else @@ -734,7 +722,7 @@ ns_implicitly_set_icon_type (struct frame *f) block_input (); pool = [[NSAutoreleasePool alloc] init]; if (f->output_data.ns->miniimage - && [[NSString stringWithUTF8String: SSDATA (f->name)] + && [[NSString stringWithLispString:f->name] isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]]) { [pool release]; @@ -759,7 +747,7 @@ ns_implicitly_set_icon_type (struct frame *f) if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/') { NSString *str - = [NSString stringWithUTF8String: SSDATA (f->name)]; + = [NSString stringWithLispString:f->name]; if ([[NSFileManager defaultManager] fileExistsAtPath: str]) image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain]; } @@ -771,8 +759,7 @@ ns_implicitly_set_icon_type (struct frame *f) image = [EmacsImage allocInitFromFile: XCDR (elt)]; if (image == nil) image = [[NSImage imageNamed: - [NSString stringWithUTF8String: - SSDATA (XCDR (elt))]] retain]; + [NSString stringWithLispString:XCDR (elt)]] retain]; } } @@ -816,8 +803,7 @@ ns_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) image = [EmacsImage allocInitFromFile: arg]; if (image == nil) - image =[NSImage imageNamed: [NSString stringWithUTF8String: - SSDATA (arg)]]; + image =[NSImage imageNamed: [NSString stringWithLispString:arg]]; if (image == nil) { @@ -851,20 +837,18 @@ ns_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) static Lisp_Object ns_appkit_version_str (void) { - char tmp[256]; + NSString *tmp; #ifdef NS_IMPL_GNUSTEP - sprintf(tmp, "gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION)); + tmp = [NSString stringWithFormat:@"gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION)]; #elif defined (NS_IMPL_COCOA) - NSString *osversion - = [[NSProcessInfo processInfo] operatingSystemVersionString]; - sprintf(tmp, "appkit-%.2f %s", - NSAppKitVersionNumber, - [osversion UTF8String]); + tmp = [NSString stringWithFormat:@"appkit-%.2f %@", + NSAppKitVersionNumber, + [[NSProcessInfo processInfo] operatingSystemVersionString]]; #else - tmp = "ns-unknown"; + tmp = [NSString initWithUTF8String:@"ns-unknown"]; #endif - return build_string (tmp); + return [tmp lispString]; } @@ -1168,7 +1152,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, be set. */ if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name)) { - fset_name (f, build_string ([ns_app_name UTF8String])); + fset_name (f, [ns_app_name lispString]); f->explicit_name = 0; } else @@ -1609,12 +1593,12 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */) Lisp_Object fname = Qnil; NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : - [NSString stringWithUTF8String: SSDATA (prompt)]; + [NSString stringWithLispString:prompt]; NSString *dirS = NILP (dir) || !STRINGP (dir) ? - [NSString stringWithUTF8String: SSDATA (BVAR (current_buffer, directory))] : - [NSString stringWithUTF8String: SSDATA (dir)]; + [NSString stringWithLispString:BVAR (current_buffer, directory)] : + [NSString stringWithLispString:dir]; NSString *initS = NILP (init) || !STRINGP (init) ? nil : - [NSString stringWithUTF8String: SSDATA (init)]; + [NSString stringWithLispString:init]; NSEvent *nxev; check_window_system (NULL); @@ -1690,7 +1674,7 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */) { NSString *str = ns_filename_from_panel (panel); if (! str) str = ns_directory_from_panel (panel); - if (str) fname = build_string ([str UTF8String]); + if (str) fname = [str lispString]; } [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; @@ -1720,7 +1704,7 @@ If OWNER is nil, Emacs is assumed. */) check_window_system (NULL); if (NILP (owner)) - owner = build_string([ns_app_name UTF8String]); + owner = [ns_app_name lispString]; CHECK_STRING (name); value = ns_get_defaults_value (SSDATA (name)); @@ -1739,20 +1723,19 @@ If VALUE is nil, the default is removed. */) { check_window_system (NULL); if (NILP (owner)) - owner = build_string ([ns_app_name UTF8String]); + owner = [ns_app_name lispString]; CHECK_STRING (name); if (NILP (value)) { [[NSUserDefaults standardUserDefaults] removeObjectForKey: - [NSString stringWithUTF8String: SSDATA (name)]]; + [NSString stringWithLispString:name]]; } else { CHECK_STRING (value); [[NSUserDefaults standardUserDefaults] setObject: - [NSString stringWithUTF8String: SSDATA (value)] - forKey: [NSString stringWithUTF8String: - SSDATA (name)]]; + [NSString stringWithLispString:value] + forKey: [NSString stringWithLispString:name]]; } return Qnil; @@ -2044,7 +2027,7 @@ The optional argument FRAME is currently ignored. */) NSEnumerator *cnames = [[clist allKeys] reverseObjectEnumerator]; NSString *cname; while ((cname = [cnames nextObject])) - list = Fcons (build_string ([cname UTF8String]), list); + list = Fcons ([cname lispString], list); /* for (i = [[clist allKeys] count] - 1; i >= 0; i--) list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i] UTF8String]), list); */ @@ -2092,13 +2075,11 @@ there was no result. */) { id pb; NSString *svcName; - char *utfStr; CHECK_STRING (service); check_window_system (NULL); - utfStr = SSDATA (service); - svcName = [NSString stringWithUTF8String: utfStr]; + svcName = [NSString stringWithLispString:service]; pb =[NSPasteboard pasteboardWithUniqueName]; ns_string_to_pasteboard (pb, send); @@ -2128,7 +2109,7 @@ ns_do_applescript (Lisp_Object script, Lisp_Object *result) NSAppleScript *scriptObject = [[NSAppleScript alloc] initWithSource: - [NSString stringWithUTF8String: SSDATA (script)]]; + [NSString stringWithLispString:script]]; returnDescriptor = [scriptObject executeAndReturnError: &errorDict]; [scriptObject release]; @@ -2151,7 +2132,7 @@ ns_do_applescript (Lisp_Object script, Lisp_Object *result) { desc = [returnDescriptor coerceToDescriptorType: typeUTF8Text]; if (desc) - *result = build_string([[desc stringValue] UTF8String]); + *result = [[desc stringValue] lispString]; } else { @@ -3031,6 +3012,60 @@ DEFUN ("ns-show-character-palette", #endif +/* Whether N bytes at STR are in the [0,127] range. */ +static bool +all_nonzero_ascii (unsigned char *str, ptrdiff_t n) +{ + for (ptrdiff_t i = 0; i < n; i++) + if (str[i] < 1 || str[i] > 127) + return false; + return true; +} + +@implementation NSString (EmacsString) +/* Make an NSString from a Lisp string. */ ++ (NSString *)stringWithLispString:(Lisp_Object)string +{ + /* Shortcut for the common case. */ + if (all_nonzero_ascii (SDATA (string), SBYTES (string))) + return [NSString stringWithCString: SSDATA (string) + encoding: NSASCIIStringEncoding]; + string = string_to_multibyte (string); + + /* Now the string is multibyte; convert to UTF-16. */ + unichar *chars = xmalloc (4 * SCHARS (string)); + unichar *d = chars; + const unsigned char *s = SDATA (string); + const unsigned char *end = s + SBYTES (string); + while (s < end) + { + int c = string_char_advance (&s); + /* We pass unpaired surrogates through, because they are typically + handled fairly well by the NS libraries (displayed with distinct + glyphs etc). */ + if (c <= 0xffff) + *d++ = c; + else if (c <= 0x10ffff) + { + *d++ = 0xd800 + ((c - 0x10000) >> 10); + *d++ = 0xdc00 + (c & 0x3ff); + } + else + *d++ = 0xfffd; /* Not valid for UTF-16. */ + } + NSString *str = [NSString stringWithCharacters: chars + length: d - chars]; + xfree (chars); + return str; +} + +/* Make a Lisp string from an NSString. */ +- (Lisp_Object)lispString +{ + return build_string ([self UTF8String]); +} +@end + /* ========================================================================== Lisp interface declaration diff --git a/src/nsterm.h b/src/nsterm.h index a511fef5b98..b56bcad4dc1 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -361,6 +361,12 @@ typedef id instancetype; @end + +@interface NSString (EmacsString) ++ (NSString *)stringWithLispString:(Lisp_Object)string; +- (Lisp_Object)lispString; +@end + /* ========================================================================== The Emacs application diff --git a/src/nsterm.m b/src/nsterm.m index 98c5b69d681..26059ab67cd 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5909,7 +5909,7 @@ ns_term_shutdown (int sig) emacs_event->kind = NS_NONKEY_EVENT; emacs_event->code = KEY_NS_OPEN_FILE_LINE; - ns_input_file = append2 (ns_input_file, build_string ([fileName UTF8String])); + ns_input_file = append2 (ns_input_file, [fileName lispString]); ns_input_line = Qnil; /* can be start or cons start,end */ emacs_event->modifiers =0; EV_TRAILER (theEvent); @@ -6273,8 +6273,7 @@ not_in_argv (NSString *arg) error: (NSString **)error { [ns_pending_service_names addObject: userData]; - [ns_pending_service_args addObject: [NSString stringWithUTF8String: - SSDATA (ns_string_from_pasteboard (pboard))]]; + [ns_pending_service_args addObject: [NSString stringWithLispString:ns_string_from_pasteboard (pboard)]]; } @@ -6291,8 +6290,8 @@ not_in_argv (NSString *arg) emacs_event->kind = NS_NONKEY_EVENT; emacs_event->code = KEY_NS_SPI_SERVICE_CALL; - ns_input_spi_name = build_string ([name UTF8String]); - ns_input_spi_arg = build_string ([arg UTF8String]); + ns_input_spi_name = [name lispString]; + ns_input_spi_arg = [arg lispString]; emacs_event->modifiers = EV_MODIFIERS (theEvent); EV_TRAILER (theEvent); @@ -6374,7 +6373,7 @@ not_in_argv (NSString *arg) size = [newFont pointSize]; ns_input_fontsize = make_fixnum (lrint (size)); - ns_input_font = build_string ([[newFont familyName] UTF8String]); + ns_input_font = [[newFont familyName] lispString]; EV_TRAILER (e); } } @@ -6685,7 +6684,7 @@ not_in_argv (NSString *arg) processingCompose = YES; [workingText release]; workingText = [str copy]; - ns_working_text = build_string ([workingText UTF8String]); + ns_working_text = [workingText lispString]; emacs_event->kind = NS_TEXT_EVENT; emacs_event->code = KEY_NS_PUT_WORKING_TEXT; @@ -7605,7 +7604,7 @@ not_in_argv (NSString *arg) tem = f->icon_name; if (!NILP (tem)) [win setMiniwindowTitle: - [NSString stringWithUTF8String: SSDATA (tem)]]; + [NSString stringWithLispString:tem]]; if (FRAME_PARENT_FRAME (f) != NULL) { @@ -8609,7 +8608,7 @@ not_in_argv (NSString *arg) fenum = [files objectEnumerator]; while ( (file = [fenum nextObject]) ) - strings = Fcons (build_string ([file UTF8String]), strings); + strings = Fcons ([file lispString], strings); } else if ([type isEqualToString: NSURLPboardType]) { @@ -8618,7 +8617,7 @@ not_in_argv (NSString *arg) type_sym = Qurl; - strings = list1 (build_string ([[url absoluteString] UTF8String])); + strings = list1 ([[url absoluteString] lispString]); } else if ([type isEqualToString: NSStringPboardType] || [type isEqualToString: NSTabularTextPboardType]) @@ -8630,7 +8629,7 @@ not_in_argv (NSString *arg) type_sym = Qnil; - strings = list1 (build_string ([data UTF8String])); + strings = list1 ([data lispString]); } else { @@ -8802,9 +8801,7 @@ not_in_argv (NSString *arg) } if (STRINGP (str)) { - const char *utfStr = SSDATA (str); - NSString *nsStr = [NSString stringWithUTF8String: utfStr]; - return nsStr; + return [NSString stringWithLispString:str]; } } diff --git a/src/process.c b/src/process.c index 15634e4a8b0..3aa105ae342 100644 --- a/src/process.c +++ b/src/process.c @@ -1654,7 +1654,10 @@ you specify a filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer. :command COMMAND -- COMMAND is a list starting with the program file -name, followed by strings to give to the program as arguments. +name, followed by strings to give to the program as arguments. If the +program file name is not an absolute file name, `make-process' will +look for the program file name in `exec-path' (which is a list of +directories). :coding CODING -- If CODING is a symbol, it specifies the coding system used for both reading and writing for this process. If CODING diff --git a/src/thread.c b/src/thread.c index b638dd77f8b..7ab1e6de1fc 100644 --- a/src/thread.c +++ b/src/thread.c @@ -28,6 +28,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "pdumper.h" #include "keyboard.h" +#if defined HAVE_GLIB && ! defined (HAVE_NS) +#include <xgselect.h> +#else +#define release_select_lock() do { } while (0) +#endif + union aligned_thread_state { struct thread_state s; @@ -586,6 +592,8 @@ really_call_select (void *arg) sa->result = (sa->func) (sa->max_fds, sa->rfds, sa->wfds, sa->efds, sa->timeout, sa->sigmask); + release_select_lock (); + block_interrupt_signal (&oldset); /* If we were interrupted by C-g while inside sa->func above, the signal handler could have called maybe_reacquire_global_lock, in diff --git a/src/xdisp.c b/src/xdisp.c index ad03ac46054..a1f7706ead2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -447,6 +447,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "termchar.h" #include "dispextern.h" #include "character.h" +#include "category.h" #include "buffer.h" #include "charset.h" #include "indent.h" @@ -508,6 +509,80 @@ static Lisp_Object list_of_error; && (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \ || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) +/* These are the category sets we use. They are defined by + kinsoku.el and chracters.el. */ +#define NOT_AT_EOL '<' +#define NOT_AT_BOL '>' +#define LINE_BREAKABLE '|' + +static bool +it_char_has_category(struct it *it, int cat) +{ + int ch = 0; + if (it->what == IT_CHARACTER) + ch = it->c; + else if (STRINGP (it->string)) + ch = SREF (it->string, IT_STRING_BYTEPOS (*it)); + else if (it->s) + ch = it->s[IT_BYTEPOS (*it)]; + else if (IT_BYTEPOS (*it) < ZV_BYTE) + ch = *BYTE_POS_ADDR (IT_BYTEPOS (*it)); + + if (ch == 0) + return false; + else + return CHAR_HAS_CATEGORY (ch, cat); +} + +/* Return true if the current character allows wrapping before it. */ +static bool +char_can_wrap_before (struct it *it) +{ + if (!Vword_wrap_by_category) + return !IT_DISPLAYING_WHITESPACE (it); + + /* For CJK (LTR) text in RTL paragraph, EOL and BOL are flipped. + Because in RTL paragraph, each glyph is prepended to the last + one, effectively drawing right to left. */ + int not_at_bol; + if (it->glyph_row && it->glyph_row->reversed_p) + not_at_bol = NOT_AT_EOL; + else + not_at_bol = NOT_AT_BOL; + /* You cannot wrap before a space or tab because that way you'll + have space and tab at the beginning of next line. */ + return (!IT_DISPLAYING_WHITESPACE (it) + /* Can be at BOL. */ + && !it_char_has_category (it, not_at_bol)); +} + +/* Return true if the current character allows wrapping after it. */ +static bool +char_can_wrap_after (struct it *it) +{ + if (!Vword_wrap_by_category) + return IT_DISPLAYING_WHITESPACE (it); + + /* For CJK (LTR) text in RTL paragraph, EOL and BOL are flipped. + Because in RTL paragraph, each glyph is prepended to the last + one, effectively drawing right to left. */ + int not_at_eol; + if (it->glyph_row && it->glyph_row->reversed_p) + not_at_eol = NOT_AT_BOL; + else + not_at_eol = NOT_AT_EOL; + + return (IT_DISPLAYING_WHITESPACE (it) + /* Can break after && can be at EOL. */ + || (it_char_has_category (it, LINE_BREAKABLE) + && !it_char_has_category (it, not_at_eol))); +} + +#undef IT_DISPLAYING_WHITESPACE +#undef NOT_AT_EOL +#undef NOT_AT_BOL +#undef LINE_BREAKABLE + /* If all the conditions needed to print the fill column indicator are met, return the (nonnegative) column number, else return a negative value. */ @@ -9193,13 +9268,20 @@ move_it_in_display_line_to (struct it *it, { if (it->line_wrap == WORD_WRAP && it->area == TEXT_AREA) { - if (IT_DISPLAYING_WHITESPACE (it)) - may_wrap = true; - else if (may_wrap) + bool next_may_wrap = may_wrap; + /* Can we wrap after this character? */ + if (char_can_wrap_after (it)) + next_may_wrap = true; + else + next_may_wrap = false; + /* Can we wrap here? */ + if (may_wrap && char_can_wrap_before (it)) { /* We have reached a glyph that follows one or more - whitespace characters. If the position is - already found, we are done. */ + whitespace characters or a character that allows + wrapping after it. If this character allows + wrapping before it, save this position as a + wrapping point. */ if (atpos_it.sp >= 0) { RESTORE_IT (it, &atpos_it, atpos_data); @@ -9214,8 +9296,10 @@ move_it_in_display_line_to (struct it *it, } /* Otherwise, we can wrap here. */ SAVE_IT (wrap_it, *it, wrap_data); - may_wrap = false; + next_may_wrap = false; } + /* Update may_wrap for the next iteration. */ + may_wrap = next_may_wrap; } } @@ -9343,10 +9427,10 @@ move_it_in_display_line_to (struct it *it, { bool can_wrap = true; - /* If we are at a whitespace character - that barely fits on this screen line, - but the next character is also - whitespace, we cannot wrap here. */ + /* If the previous character says we can + wrap after it, but the current + character says we can't wrap before + it, then we can't wrap here. */ if (it->line_wrap == WORD_WRAP && wrap_it.sp >= 0 && may_wrap @@ -9358,7 +9442,7 @@ move_it_in_display_line_to (struct it *it, SAVE_IT (tem_it, *it, tem_data); set_iterator_to_next (it, true); if (get_next_display_element (it) - && IT_DISPLAYING_WHITESPACE (it)) + && !char_can_wrap_before (it)) can_wrap = false; RESTORE_IT (it, &tem_it, tem_data); } @@ -9437,19 +9521,18 @@ move_it_in_display_line_to (struct it *it, else IT_RESET_X_ASCENT_DESCENT (it); - /* If the screen line ends with whitespace, and we - are under word-wrap, don't use wrap_it: it is no - longer relevant, but we won't have an opportunity - to update it, since we are done with this screen - line. */ + /* If the screen line ends with whitespace (or + wrap-able character), and we are under word-wrap, + don't use wrap_it: it is no longer relevant, but + we won't have an opportunity to update it, since + we are done with this screen line. */ if (may_wrap && IT_OVERFLOW_NEWLINE_INTO_FRINGE (it) /* If the character after the one which set the - may_wrap flag is also whitespace, we can't - wrap here, since the screen line cannot be - wrapped in the middle of whitespace. - Therefore, wrap_it _is_ relevant in that - case. */ - && !(moved_forward && IT_DISPLAYING_WHITESPACE (it))) + may_wrap flag says we can't wrap before it, + we can't wrap here. Therefore, wrap_it + (previously found wrap-point) _is_ relevant + in that case. */ + && !(moved_forward && char_can_wrap_before (it))) { /* If we've found TO_X, go back there, as we now know the last word fits on this screen line. */ @@ -23322,9 +23405,14 @@ display_line (struct it *it, int cursor_vpos) if (it->line_wrap == WORD_WRAP && it->area == TEXT_AREA) { - if (IT_DISPLAYING_WHITESPACE (it)) - may_wrap = true; - else if (may_wrap) + bool next_may_wrap = may_wrap; + /* Can we wrap after this character? */ + if (char_can_wrap_after (it)) + next_may_wrap = true; + else + next_may_wrap = false; + /* Can we wrap here? */ + if (may_wrap && char_can_wrap_before (it)) { SAVE_IT (wrap_it, *it, wrap_data); wrap_x = x; @@ -23338,8 +23426,9 @@ display_line (struct it *it, int cursor_vpos) wrap_row_min_bpos = min_bpos; wrap_row_max_pos = max_pos; wrap_row_max_bpos = max_bpos; - may_wrap = false; } + /* Update may_wrap for the next iteration. */ + may_wrap = next_may_wrap; } } @@ -23463,14 +23552,18 @@ display_line (struct it *it, int cursor_vpos) /* If line-wrap is on, check if a previous wrap point was found. */ if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it) - && wrap_row_used > 0 + && wrap_row_used > 0 /* Found. */ /* Even if there is a previous wrap point, continue the line here as usual, if (i) the previous character - was a space or tab AND (ii) the - current character is not. */ - && (!may_wrap - || IT_DISPLAYING_WHITESPACE (it))) + allows wrapping after it, AND (ii) + the current character allows wrapping + before it. Because this is a valid + break point, we can just continue to + the next line at here, there is no + need to wrap early at the previous + wrap point. */ + && (!may_wrap || !char_can_wrap_before (it))) goto back_to_wrap; /* Record the maximum and minimum buffer @@ -23498,13 +23591,16 @@ display_line (struct it *it, int cursor_vpos) /* If line-wrap is on, check if a previous wrap point was found. */ else if (wrap_row_used > 0 - /* Even if there is a previous wrap - point, continue the line here as - usual, if (i) the previous character - was a space or tab AND (ii) the - current character is not. */ - && (!may_wrap - || IT_DISPLAYING_WHITESPACE (it))) + /* Even if there is a previous + wrap point, continue the + line here as usual, if (i) + the previous character was a + space or tab AND (ii) the + current character is not, + AND (iii) the current + character allows wrapping + before it. */ + && (!may_wrap || !char_can_wrap_before (it))) goto back_to_wrap; } @@ -34662,6 +34758,23 @@ A value of nil means to respect the value of `truncate-lines'. If `word-wrap' is enabled, you might want to reduce this. */); Vtruncate_partial_width_windows = make_fixnum (50); + DEFVAR_BOOL("word-wrap-by-category", Vword_wrap_by_category, doc: /* + Non-nil means also wrap after characters of a certain category. +Normally when `word-wrap' is on, Emacs only breaks lines after +whitespace characters. When this option is turned on, Emacs also +breaks lines after characters that have the "|" category (defined in +characters.el). This is useful for allowing breaking after CJK +characters and improves the word-wrapping for CJK text mixed with +Latin text. + +If this variable is set using Customize, Emacs automatically loads +kinsoku.el. When kinsoku.el is loaded, Emacs respects kinsoku rules +when breaking lines. That means characters with the ">" category +don't appear at the beginning of a line (e.g., FULLWIDTH COMMA), and +characters with the "<" category don't appear at the end of a line +(e.g., LEFT DOUBLE ANGLE BRACKET). */); + Vword_wrap_by_category = false; + DEFVAR_LISP ("line-number-display-limit", Vline_number_display_limit, doc: /* Maximum buffer size for which line number should be displayed. If the buffer is bigger than this, the line number does not appear diff --git a/src/xgselect.c b/src/xgselect.c index f8d0bac7fac..be70107b756 100644 --- a/src/xgselect.c +++ b/src/xgselect.c @@ -29,6 +29,27 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "blockinput.h" #include "systime.h" +static ptrdiff_t threads_holding_glib_lock; +static GMainContext *glib_main_context; + +void release_select_lock (void) +{ + if (--threads_holding_glib_lock == 0) + g_main_context_release (glib_main_context); +} + +static void acquire_select_lock (GMainContext *context) +{ + if (threads_holding_glib_lock++ == 0) + { + glib_main_context = context; + while (!g_main_context_acquire (context)) + { + /* Spin. */ + } + } +} + /* `xg_select' is a `pselect' replacement. Why do we need a separate function? 1. Timeouts. Glib and Gtk rely on timer events. If we did pselect with a greater timeout then the one scheduled by Glib, we would @@ -54,26 +75,19 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds, GPollFD *gfds = gfds_buf; int gfds_size = ARRAYELTS (gfds_buf); int n_gfds, retval = 0, our_fds = 0, max_fds = fds_lim - 1; - bool context_acquired = false; int i, nfds, tmo_in_millisec, must_free = 0; bool need_to_dispatch; context = g_main_context_default (); - context_acquired = g_main_context_acquire (context); - /* FIXME: If we couldn't acquire the context, we just silently proceed - because this function handles more than just glib file descriptors. - Note that, as implemented, this failure is completely silent: there is - no feedback to the caller. */ + acquire_select_lock (context); if (rfds) all_rfds = *rfds; else FD_ZERO (&all_rfds); if (wfds) all_wfds = *wfds; else FD_ZERO (&all_wfds); - n_gfds = (context_acquired - ? g_main_context_query (context, G_PRIORITY_LOW, &tmo_in_millisec, - gfds, gfds_size) - : -1); + n_gfds = g_main_context_query (context, G_PRIORITY_LOW, &tmo_in_millisec, + gfds, gfds_size); if (gfds_size < n_gfds) { @@ -151,8 +165,10 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds, #else need_to_dispatch = true; #endif - if (need_to_dispatch && context_acquired) + if (need_to_dispatch) { + acquire_select_lock (context); + int pselect_errno = errno; /* Prevent g_main_dispatch recursion, that would occur without block_input wrapper, because event handlers call @@ -162,11 +178,9 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds, g_main_context_dispatch (context); unblock_input (); errno = pselect_errno; + release_select_lock (); } - if (context_acquired) - g_main_context_release (context); - /* To not have to recalculate timeout, return like this. */ if ((our_fds > 0 || (nfds == 0 && tmop == &tmo)) && (retval == 0)) { diff --git a/src/xgselect.h b/src/xgselect.h index a38591f3296..512bf3ad85f 100644 --- a/src/xgselect.h +++ b/src/xgselect.h @@ -29,4 +29,6 @@ extern int xg_select (int max_fds, fd_set *rfds, fd_set *wfds, fd_set *efds, struct timespec *timeout, sigset_t *sigmask); +extern void release_select_lock (void); + #endif /* XGSELECT_H */ diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index fe1460cf29e..233d43cd01a 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -123,4 +123,24 @@ (should (equal (decoded-time-period '((135 . 10) 0 0 0 0 0 nil nil nil)) 13.5))) +(ert-deftest test-time-wrap-addition () + (should (equal (decoded-time-add '(0 0 0 1 11 2008 nil nil nil) + (make-decoded-time :month 1)) + '(0 0 0 1 12 2008 nil nil nil))) + (should (equal (decoded-time-add '(0 0 0 1 12 2008 nil nil nil) + (make-decoded-time :month 1)) + '(0 0 0 1 1 2009 nil nil nil))) + (should (equal (decoded-time-add '(0 0 0 1 11 2008 nil nil nil) + (make-decoded-time :month 12)) + '(0 0 0 1 11 2009 nil nil nil))) + (should (equal (decoded-time-add '(0 0 0 1 11 2008 nil nil nil) + (make-decoded-time :month 13)) + '(0 0 0 1 12 2009 nil nil nil))) + (should (equal (decoded-time-add '(0 0 0 30 12 2008 nil nil nil) + (make-decoded-time :day 1)) + '(0 0 0 31 12 2008 nil nil nil))) + (should (equal (decoded-time-add '(0 0 0 30 12 2008 nil nil nil) + (make-decoded-time :day 2)) + '(0 0 0 1 1 2009 nil nil nil)))) + ;;; time-date-tests.el ends here diff --git a/test/lisp/calendar/todo-mode-resources/todo-test-1.todo b/test/lisp/calendar/todo-mode-resources/todo-test-1.todo index 598d487cad9..557134fd454 100644 --- a/test/lisp/calendar/todo-mode-resources/todo-test-1.todo +++ b/test/lisp/calendar/todo-mode-resources/todo-test-1.todo @@ -1,4 +1,4 @@ -(("testcat1" . [2 0 2 1]) ("testcat2" . [3 0 1 1]) ("testcat3" . [0 0 0 0])) +(("testcat1" . [2 0 2 1]) ("testcat2" . [3 0 1 1]) ("testcat3" . [0 0 0 0]) ("testcat4" . [1 0 0 0])) --==-- testcat1 [May 29, 2017] testcat1 item3 has more than one line @@ -18,3 +18,7 @@ --==-- testcat3 ==--== DONE +--==-- testcat4 +[Jan 1, 2020] testcat4 item1 + +==--== DONE diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index d65f94d4f31..a19612ee562 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -848,6 +848,52 @@ should display the previously current (or default) todo file." (should (equal todo-current-todo-file todo-test-file-1)) (delete-file (concat file "~"))))) +(ert-deftest todo-test-edit-item-date-month () + "Test incrementing and decrementing the month of an item's date. +If the change in month crosses a year boundary, the year of the +item's date should be adjusted accordingly." + (with-todo-test + (todo-test--show 4) + (let ((current-prefix-arg t) ; For todo-edit-item--header. + (get-date (lambda () + (save-excursion + (todo-date-string-matcher (line-end-position)) + (buffer-substring-no-properties (match-beginning 1) + (match-end 0)))))) + (should (equal (funcall get-date) "Jan 1, 2020")) + (todo-edit-item--header 'month 0) + (should (equal (funcall get-date) "Jan 1, 2020")) + (todo-edit-item--header 'month 1) + (should (equal (funcall get-date) "Feb 1, 2020")) + (todo-edit-item--header 'month -1) + (should (equal (funcall get-date) "Jan 1, 2020")) + (todo-edit-item--header 'month -1) + (should (equal (funcall get-date) "Dec 1, 2019")) + (todo-edit-item--header 'month 1) + (should (equal (funcall get-date) "Jan 1, 2020")) + (todo-edit-item--header 'month 12) + (should (equal (funcall get-date) "Jan 1, 2021")) + (todo-edit-item--header 'month -12) + (should (equal (funcall get-date) "Jan 1, 2020")) + (todo-edit-item--header 'month -13) + (should (equal (funcall get-date) "Dec 1, 2018")) + (todo-edit-item--header 'month 7) + (should (equal (funcall get-date) "Jul 1, 2019")) + (todo-edit-item--header 'month 6) + (should (equal (funcall get-date) "Jan 1, 2020")) + (todo-edit-item--header 'month 23) + (should (equal (funcall get-date) "Dec 1, 2021")) + (todo-edit-item--header 'month -23) + (should (equal (funcall get-date) "Jan 1, 2020")) + (todo-edit-item--header 'month 24) + (should (equal (funcall get-date) "Jan 1, 2022")) + (todo-edit-item--header 'month -24) + (should (equal (funcall get-date) "Jan 1, 2020")) + (todo-edit-item--header 'month 25) + (should (equal (funcall get-date) "Feb 1, 2022")) + (todo-edit-item--header 'month -25) + (should (equal (funcall get-date) "Jan 1, 2020")) + ))) (provide 'todo-mode-tests) ;;; todo-mode-tests.el ends here diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el new file mode 100644 index 00000000000..48a9996e7a8 --- /dev/null +++ b/test/lisp/gnus/gnus-icalendar-tests.el @@ -0,0 +1,244 @@ +;;; gnus-icalendar-tests.el --- tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Jan Tatarik <jtatarik@liveintent.com> +;; Keywords: + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'gnus-icalendar) + + +(defun gnus-icalendar-tests--get-ical-event (ical-string &optional participant) + "Return gnus-icalendar event for ICAL-STRING." + (let (event) + (with-temp-buffer + (insert ical-string) + (setq event (gnus-icalendar-event-from-buffer (buffer-name) participant))) + event)) + +(defun icalendar-tests--get-ical-event (ical-string) + "Return iCalendar event for ICAL-STRING." + (save-excursion + (with-temp-buffer + (insert ical-string) + (goto-char (point-min)) + (car (icalendar--read-element nil nil))))) + +(ert-deftest gnus-icalendar-parse () + "test" + (let ((tz (getenv "TZ")) + (event (gnus-icalendar-tests--get-ical-event " +BEGIN:VCALENDAR +PRODID:-//Google Inc//Google Calendar 70.9054//EN +VERSION:2.0 +CALSCALE:GREGORIAN +METHOD:REQUEST +BEGIN:VTIMEZONE +TZID:America/New_York +X-LIC-LOCATION:America/New_York +BEGIN:DAYLIGHT +TZOFFSETFROM:-0500 +TZOFFSETTO:-0400 +TZNAME:EDT +DTSTART:19700308T020000 +RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=2SU +END:DAYLIGHT +BEGIN:STANDARD +TZOFFSETFROM:-0400 +TZOFFSETTO:-0500 +TZNAME:EST +DTSTART:19701101T020000 +RRULE:FREQ=YEARLY;BYMONTH=11;BYDAY=1SU +END:STANDARD +END:VTIMEZONE +BEGIN:VEVENT +DTSTART;TZID=America/New_York:20201208T090000 +DTEND;TZID=America/New_York:20201208T100000 +DTSTAMP:20200728T182853Z +ORGANIZER;CN=Company Events:mailto:liveintent.com_3bm6fh805bme9uoeliqcle1sa + g@group.calendar.google.com +UID:iipdt88slddpeu7hheuu09sfmd@google.com +X-MICROSOFT-CDO-OWNERAPPTID:-362490173 +RECURRENCE-ID;TZID=America/New_York:20201208T091500 +CREATED:20200309T134939Z +DESCRIPTION:In this meeting\, we will cover topics from product and enginee + ring presentations and demos to new hire announcements to watching the late +LAST-MODIFIED:20200728T182852Z +LOCATION:New York-22-Town Hall Space (250) [Chrome Box] +SEQUENCE:4 +STATUS:CONFIRMED +SUMMARY:Townhall | All Company Meeting +TRANSP:OPAQUE +END:VEVENT +END:VCALENDAR +"))) + + (unwind-protect + (progn + ;; Use this form so as not to rely on system tz database. + ;; Eg hydra.nixos.org. + (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") + (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) + (should (not (gnus-icalendar-event:recurring-p event))) + (should (string= (gnus-icalendar-event:start event) "2020-12-08 15:00")) + (with-slots (organizer summary description location end-time uid rsvp participation-type) event + (should (string= organizer "liveintent.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com")) + (should (string= summary "Townhall | All Company Meeting")) + (should (string= description "In this meeting\, we will cover topics from product and engineering presentations and demos to new hire announcements to watching the late")) + (should (string= location "New York-22-Town Hall Space (250) [Chrome Box]")) + (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-12-08 16:00")) + (should (string= uid "iipdt88slddpeu7hheuu09sfmd@google.com")) + (should (not rsvp)) + (should (eq participation-type 'non-participant)))) + (setenv "TZ" tz)))) + +(ert-deftest gnus-icalendary-byday () + "" + (let ((tz (getenv "TZ")) + (event (gnus-icalendar-tests--get-ical-event " +BEGIN:VCALENDAR +PRODID:Zimbra-Calendar-Provider +VERSION:2.0 +METHOD:REQUEST +BEGIN:VTIMEZONE +TZID:America/New_York +BEGIN:STANDARD +DTSTART:16010101T020000 +TZOFFSETTO:-0500 +TZOFFSETFROM:-0400 +RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=11;BYDAY=1SU +TZNAME:EST +END:STANDARD +BEGIN:DAYLIGHT +DTSTART:16010101T020000 +TZOFFSETTO:-0400 +TZOFFSETFROM:-0500 +RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=3;BYDAY=2SU +TZNAME:EDT +END:DAYLIGHT +END:VTIMEZONE +BEGIN:VEVENT +UID:903a5415-9067-4f63-b499-1b6205f49c88 +RRULE:FREQ=DAILY;UNTIL=20200825T035959Z;INTERVAL=1;BYDAY=MO,TU,WE,TH,FR +SUMMARY:appointment every weekday\, start jul 24\, 2020\, end aug 24\, 2020 +ATTENDEE;CN=Mark Hershberger;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP + =TRUE:mailto:hexmode <at> gmail.com +ORGANIZER;CN=Mark A. Hershberger:mailto:mah <at> nichework.com +DTSTART;TZID=\"America/New_York\":20200724T090000 +DTEND;TZID=\"America/New_York\":20200724T093000 +STATUS:CONFIRMED +CLASS:PUBLIC +X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY +TRANSP:OPAQUE +LAST-MODIFIED:20200719T150815Z +DTSTAMP:20200719T150815Z +SEQUENCE:0 +DESCRIPTION:The following is a new meeting request: +BEGIN:VALARM +ACTION:DISPLAY +TRIGGER;RELATED=START:-PT5M +DESCRIPTION:Reminder +END:VALARM +END:VEVENT +END:VCALENDAR" (list "Mark Hershberger")))) + + (unwind-protect + (progn + ;; Use this form so as not to rely on system tz database. + ;; Eg hydra.nixos.org. + (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") + (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) + (should (gnus-icalendar-event:recurring-p event)) + (should (string= (gnus-icalendar-event:recurring-interval event) "1")) + (should (string= (gnus-icalendar-event:start event) "2020-07-24 15:00")) + (with-slots (organizer summary description location end-time uid rsvp participation-type) event + (should (string= organizer "mah <at> nichework.com")) + (should (string= summary "appointment every weekday\, start jul 24\, 2020\, end aug 24\, 2020")) + (should (string= description "The following is a new meeting request:")) + (should (null location)) + (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-07-24 15:30")) + (should (string= uid "903a5415-9067-4f63-b499-1b6205f49c88")) + (should rsvp) + (should (eq participation-type 'required))) + (should (equal (gnus-icalendar-event:recurring-days event) '(1 2 3 4 5))) + (should (string= (gnus-icalendar-event:org-timestamp event) "<2020-07-24 15:00-15:30 +1w> +<2020-07-27 15:00-15:30 +1w> +<2020-07-28 15:00-15:30 +1w> +<2020-07-29 15:00-15:30 +1w> +<2020-07-30 15:00-15:30 +1w>"))) + (setenv "TZ" tz)))) + + +;; (VCALENDAR nil +;; ((PRODID nil "Zimbra-Calendar-Provider") +;; (VERSION nil "2.0") +;; (METHOD nil "REQUEST")) +;; ((VTIMEZONE nil +;; ((TZID nil "America/New_York")) +;; ((STANDARD nil +;; ((DTSTART nil "16010101T020000") +;; (TZOFFSETTO nil "-0500") +;; (TZOFFSETFROM nil "-0400") +;; (RRULE nil "FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=11;BYDAY=1SU") +;; (TZNAME nil "EST")) +;; nil) +;; (DAYLIGHT nil +;; ((DTSTART nil "16010101T020000") +;; (TZOFFSETTO nil "-0400") +;; (TZOFFSETFROM nil "-0500") +;; (RRULE nil "FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=3;BYDAY=2SU") +;; (TZNAME nil "EDT")) +;; nil))) +;; (VEVENT nil +;; ((UID nil "903a5415-9067-4f63-b499-1b6205f49c88") +;; (RRULE nil "FREQ=DAILY;UNTIL=20200825T035959Z;INTERVAL=1;BYDAY=MO,TU,WE,TH,FR") +;; (SUMMARY nil "appointment every weekday, start jul 24, 2020, end aug 24, 2020") +;; (ATTENDEE +;; (CN "Mark Hershberger" ROLE "REQ-PARTICIPANT" PARTSTAT "NEEDS-ACTION" CN "Mark A. Hershberger") +;; "mailto:mah <at> nichework.com") +;; (DTSTART +;; (TZID "America/New_York") +;; "20200724T090000") +;; (DTEND +;; (TZID "America/New_York") +;; "20200724T093000") +;; (STATUS nil "CONFIRMED") +;; (CLASS nil "PUBLIC") +;; (X-MICROSOFT-CDO-INTENDEDSTATUS nil "BUSY") +;; (TRANSP nil "OPAQUE") +;; (LAST-MODIFIED nil "20200719T150815Z") +;; (DTSTAMP nil "20200719T150815Z") +;; (SEQUENCE nil "0") +;; (DESCRIPTION nil "The following is a new meeting request:")) +;; ((VALARM nil +;; ((ACTION nil "DISPLAY") +;; (TRIGGER +;; (RELATED "START") +;; "-PT5M") +;; (DESCRIPTION nil "Reminder")) +;; nil))))) + +(provide 'gnus-icalendar-tests) +;;; gnus-icalendar-tests.el ends here diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el index 9277d0162e8..16e591f1dd5 100644 --- a/test/lisp/international/ccl-tests.el +++ b/test/lisp/international/ccl-tests.el @@ -232,3 +232,17 @@ At EOF: (with-temp-buffer (ccl-dump prog-midi-code) (should (equal (buffer-string) prog-midi-dump)))) + +(ert-deftest ccl-hash-table () + (let ((sym (gensym)) + (table (make-hash-table :test 'eq))) + (puthash 16 17 table) + (puthash 17 16 table) + (define-translation-hash-table sym table) + (let* ((prog `(2 + ((loop + (lookup-integer ,sym r0 r1))))) + (compiled (ccl-compile prog)) + (registers [17 0 0 0 0 0 0 0])) + (ccl-execute compiled registers) + (should (equal registers [2 16 0 0 0 0 0 1]))))) diff --git a/test/lisp/mwheel-tests.el b/test/lisp/mwheel-tests.el new file mode 100644 index 00000000000..f2989d608b4 --- /dev/null +++ b/test/lisp/mwheel-tests.el @@ -0,0 +1,38 @@ +;;; mwheel-tests.el --- tests for mwheel.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'mwheel) + +(ert-deftest mwheel-test--create-scroll-keys () + (should (equal (mouse-wheel--create-scroll-keys 10 'mouse-1) + '([mouse-1] + [left-margin mouse-1] [right-margin mouse-1] + [left-fringe mouse-1] [right-fringe mouse-1] + [vertical-scroll-bar mouse-1] [horizontal-scroll-bar mouse-1] + [mode-line mouse-1] [header-line mouse-1]))) + ;; Don't bind modifiers outside of buffer area (e.g. for fringes). + (should (equal (mouse-wheel--create-scroll-keys '((shift) . 1) 'mouse-1) + '([mouse-1]))) + (should (equal (mouse-wheel--create-scroll-keys '((control) . 9) 'mouse-7) + '([mouse-7])))) + +;;; mwheel-tests.el ends here |