diff options
380 files changed, 8770 insertions, 3987 deletions
diff --git a/ChangeLog.3 b/ChangeLog.3 index c8dd40b5eb6..1a530118995 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -1,3 +1,99 @@ +2020-08-03 Phil Sainty <psainty@orcon.net.nz> + + lisp/so-long.el: Improve support for major mode hooks + + * lisp/so-long.el (so-long-remember-all, so-long-disable-minor-modes) + (so-long-override-variables): Store and use the `so-long-minor-modes' + and `so-long-variable-overrides' values seen by the original major + mode, so that buffer-local changes made in the major mode hook will be + respected. + + Add documentation of this and other major mode hook usage. + +2020-08-02 Grégory Mounié <Gregory.Mounie@imag.fr> (tiny change) + + Avoid segfaults if XIM is set but not xim_styles + + Emacs segfaults at the X11 initialization if XIM is set + and xim_styles is NULL. This patch avoids the crash. + * src/xfns.c: Check also if FRAME_X_XIM_STYLES(f) is NULL. + (Bug#42676) (Bug#42673) (Bug#42677) + +2020-07-31 Philipp Stephani <phst@google.com> + + Backport: Make checking for liveness of global values more precise. + + We can't just use a hash lookup because a global and a local reference + might refer to the same Lisp object. + + * src/emacs-module.c (module_free_global_ref): More precise check for + global liveness. + + (cherry picked from commit 9f01ce6327af886f26399924a9aadf16cdd4fd9f) + +2020-07-31 Philipp Stephani <phst@google.com> + + Backport: Fix subtle bug when checking liveness of module values. + + We can't simply look up the Lisp object in the global reference table + because an invalid local and a valid global reference might refer to + the same object. Instead, we have to test the address of the global + reference against the stored references. + + * src/emacs-module.c (module_global_reference_p): New helper function. + (value_to_lisp): Use it. + + (cherry picked from commit 6355a3ec62f43c9b99d483982ff851d32dd78891) + +2020-07-31 Philipp Stephani <phst@google.com> + + Backport: Fix memory leak for global module objects (Bug#42482). + + Instead of storing the global values in a global 'emacs_value_storage' + object, store them as hash values alongside the reference counts. + That way the garbage collector takes care of cleaning them up. + + * src/emacs-module.c (global_storage): Remove. + (struct module_global_reference): New pseudovector type. + (XMODULE_GLOBAL_REFERENCE): New helper function. + (module_make_global_ref, module_free_global_ref): Use + 'module_global_reference' struct for global reference values. + (value_to_lisp, module_handle_nonlocal_exit): Adapt to deletion of + 'global_storage'. + + (cherry picked from commit 5c5eb9790898e4ab10bcbbdb6871947ed3018569) + +2020-07-30 Nicolas Petton <nicolas@petton.fr> + + * admin/authors.el (authors-aliases): Remove a faulty regexp. + +2020-07-29 Stefan Kangas <stefankangas@gmail.com> + + * doc/lispref/symbols.texi (Definitions): Fix typo. + +2020-07-28 Nicolas Petton <nicolas@petton.fr> + + * etc/HISTORY: Add Emacs 27.1 release date. + +2020-07-28 Nicolas Petton <nicolas@petton.fr> + + Bump Emacs version to 27.1 + + * README: + * configure.ac: + * msdos/sed2v2.inp: + * nt/README.W32: Bump Emacs version. + +2020-07-28 Nicolas Petton <nicolas@petton.fr> + + * etc/AUTHORS: Update. + +2020-07-28 Nicolas Petton <nicolas@petton.fr> + + Update authors.el + + * admin/authors.el (authors-aliases): Add author aliases. + 2020-07-28 Nicolas Petton <nicolas@petton.fr> * etc/NEWS: Remove temporary markup. @@ -2862,7 +2958,7 @@ * doc/lispref/searching.texi (Rx Constructs): Document. * lisp/emacs-lisp/rx.el (rx--normalise-or-arg) (rx--all-string-or-args): New. - (rx--translate-or): Normalise arguments first, and check for strings + (rx--translate-or): Normalize arguments first, and check for strings in subforms. (rx--expand-eval): Extracted from rx--translate-eval. (rx--translate-eval): Call rx--expand-eval. @@ -142382,7 +142478,7 @@ This file records repository revisions from commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to -commit 56f958807c0b8ea8f45e3c088157ca144a1b1fac (inclusive). +commit 1ca4da054be7eb340c511d817f3ec89c8b819db7 (inclusive). See ChangeLog.2 for earlier changes. ;; Local Variables: diff --git a/Makefile.in b/Makefile.in index 67e15cfecd2..fbb1891ba72 100644 --- a/Makefile.in +++ b/Makefile.in @@ -714,6 +714,13 @@ install-etc: ${srcdir}/etc/emacs.desktop > $${tmp}; \ ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop"; \ rm -f $${tmp} + tmp=etc/emacsclient.tmpdesktop; rm -f $${tmp}; \ + client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \ + sed -e "/^Exec=emacsclient/ s|emacsclient|${bindir}/$${client_name}|" \ + -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \ + ${srcdir}/etc/emacsclient.desktop > $${tmp}; \ + ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/$${client_name}.desktop"; \ + rm -f $${tmp} umask 022; ${MKDIR_P} "$(DESTDIR)${appdatadir}" tmp=etc/emacs.tmpappdata; rm -f $${tmp}; \ sed -e "s/emacs\.desktop/${EMACS_NAME}.desktop/" \ diff --git a/admin/release-process b/admin/release-process index 1ed7a2e29e7..b8587e62047 100644 --- a/admin/release-process +++ b/admin/release-process @@ -192,16 +192,14 @@ sk Miroslav Vaško ** Check for modes which bind M-s that conflicts with a new global binding M-s and change key bindings where necessary. The current list of modes: -1. Gnus binds 'M-s' to 'gnus-summary-search-article-forward'. - -2. Minibuffer binds 'M-s' to 'next-matching-history-element' +1. Minibuffer binds 'M-s' to 'next-matching-history-element' (not useful any more since C-s can now search in the history). -3. PCL-CVS binds 'M-s' to 'cvs-status', and log-edit-mode binds it to +2. PCL-CVS binds 'M-s' to 'cvs-status', and log-edit-mode binds it to 'log-edit-comment-search-forward'. Perhaps search commands on the global key binding 'M-s' are useless in these modes. -4. Rmail binds '\es' to 'rmail-search'/'rmail-summary-search'. +3. Rmail binds '\es' to 'rmail-search'/'rmail-summary-search'. * DOCUMENTATION diff --git a/configure.ac b/configure.ac index c9aa076eb3b..ace1085284e 100644 --- a/configure.ac +++ b/configure.ac @@ -219,6 +219,21 @@ AC_DEFUN([OPTION_DEFAULT_OFF], [dnl m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=no])dnl ])dnl +dnl OPTION_DEFAULT_IFAVAILABLE(NAME, HELP-STRING) +dnl Create a new --with option that defaults to 'ifavailable'. +dnl NAME is the base name of the option. The shell variable with_NAME +dnl will be set to either the user's value (if the option is +dnl specified; 'yes' for a plain --with-NAME) or to 'ifavailable' (if the +dnl option is not specified). Note that the shell variable name is +dnl constructed as autoconf does, by replacing non-alphanumeric +dnl characters with "_". +dnl HELP-STRING is the help text for the option. +AC_DEFUN([OPTION_DEFAULT_IFAVAILABLE], [dnl + AC_ARG_WITH([$1],[AS_HELP_STRING([--with-$1],[$2])],[],[dnl + m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=ifavailable])dnl +])dnl + + dnl OPTION_DEFAULT_ON(NAME, HELP-STRING) dnl Create a new --with option that defaults to $with_features. dnl NAME is the base name of the option. The shell variable with_NAME @@ -438,7 +453,7 @@ OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing]) OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support]) OPTION_DEFAULT_ON([native-image-api], [don't use native image APIs (GDI+ on Windows)]) -OPTION_DEFAULT_ON([json], [don't compile with native JSON support]) +OPTION_DEFAULT_IFAVAILABLE([json], [don't compile with native JSON support]) OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text shaping]) @@ -489,7 +504,7 @@ otherwise for the first of 'inotify', 'kqueue' or 'gfile' that is usable.]) [with_file_notification=$with_features]) OPTION_DEFAULT_OFF([xwidgets], - [enable use of some gtk widgets in Emacs buffers (requires gtk3)]) + [enable use of xwidgets in Emacs buffers (requires gtk3 or macOS Cocoa)]) ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. @@ -708,7 +723,7 @@ case "${canonical}" in *-apple-darwin* ) case "${canonical}" in *-apple-darwin[0-9].*) unported=yes ;; - i[3456]86-* | x86_64-* ) ;; + i[3456]86-* | x86_64-* | arm-* ) ;; * ) unported=yes ;; esac opsys=darwin @@ -1011,7 +1026,10 @@ AS_IF([test $gl_gcc_warnings = no], [# Use -fanalyzer and related options only if --enable-gcc-warnings, # as they slow GCC considerably. nw="$nw -fanalyzer -Wno-analyzer-double-free -Wno-analyzer-malloc-leak" - nw="$nw -Wno-analyzer-null-dereference -Wno-analyzer-use-after-free"]) + nw="$nw -Wno-analyzer-null-dereference -Wno-analyzer-use-after-free" + # Use -Wsuggest-attribute=malloc only if --enable-gcc-warnings, + # as it doesn't flag code that is wrong in any way. + nw="$nw -Wsuggest-attribute=malloc"]) nw="$nw -Wcast-align=strict" # Emacs is tricky with pointers. nw="$nw -Wduplicated-branches" # Too many false alarms @@ -2754,20 +2772,34 @@ fi dnl Enable xwidgets if GTK3 and WebKitGTK+ are available. +dnl Enable xwidgets if macOS Cocoa and WebKit framework are available. HAVE_XWIDGETS=no XWIDGETS_OBJ= if test "$with_xwidgets" != "no"; then - test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none" || - AC_MSG_ERROR([xwidgets requested but gtk3 not used.]) + if test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none"; then + WEBKIT_REQUIRED=2.12 + WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED" + EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES]) + HAVE_XWIDGETS=$HAVE_WEBKIT + XWIDGETS_OBJ="xwidget.o" + elif test "${NS_IMPL_COCOA}" = "yes"; then + dnl FIXME: Check framework WebKit2 + dnl WEBKIT_REQUIRED=M.m.p + WEBKIT_LIBS="-Wl,-framework -Wl,WebKit" + WEBKIT_CFLAGS="-I/System/Library/Frameworks/WebKit.framework/Headers" + HAVE_WEBKIT="yes" + HAVE_XWIDGETS=$HAVE_WEBKIT + XWIDGETS_OBJ="xwidget.o" + NS_OBJC_OBJ="$NS_OBJC_OBJ nsxwidget.o" + dnl Update NS_OBJC_OBJ with added nsxwidget.o + AC_SUBST(NS_OBJC_OBJ) + else + AC_MSG_ERROR([xwidgets requested, it requires GTK3 as X window toolkit or macOS Cocoa as window system.]) + fi - WEBKIT_REQUIRED=2.12 - WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED" - EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES]) - HAVE_XWIDGETS=$HAVE_WEBKIT test $HAVE_XWIDGETS = yes || - AC_MSG_ERROR([xwidgets requested but WebKitGTK+ not found.]) + AC_MSG_ERROR([xwidgets requested but WebKitGTK+ or WebKit framework not found.]) - XWIDGETS_OBJ=xwidget.o AC_DEFINE([HAVE_XWIDGETS], 1, [Define to 1 if you have xwidgets support.]) fi AC_SUBST(XWIDGETS_OBJ) @@ -2912,7 +2944,7 @@ AC_SUBST(LIBSYSTEMD_CFLAGS) HAVE_JSON=no JSON_OBJ= -if test "${with_json}" = yes; then +if test "${with_json}" != no; then EMACS_CHECK_MODULES([JSON], [jansson >= 2.7], [HAVE_JSON=yes], [HAVE_JSON=no]) if test "${HAVE_JSON}" = yes; then @@ -3863,6 +3895,11 @@ case $with_gnutls,$HAVE_GNUTLS in *) MISSING="$MISSING gnutls" WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-gnutls=ifavailable";; esac +case $with_json,$HAVE_JSON in + no,* | ifavailable,* | *,yes) ;; + *) MISSING="$MISSING json" + WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-json=ifavailable";; +esac if test "X${MISSING}" != X; then AC_MSG_ERROR([The following required libraries were not found: $MISSING @@ -5688,7 +5725,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs directly use zlib? ${HAVE_ZLIB} Does Emacs have dynamic modules support? ${HAVE_MODULES} Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS} - Does Emacs support Xwidgets (requires gtk3)? ${HAVE_XWIDGETS} + Does Emacs support Xwidgets? ${HAVE_XWIDGETS} Does Emacs have threading support in lisp? ${threads_enabled} Does Emacs support the portable dumper? ${with_pdumper} Does Emacs support legacy unexec dumping? ${with_unexec} diff --git a/debian/changelog b/debian/changelog index 4f4fcb617a7..3add5048fc3 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +emacs-snapshot (28~git20200820.1) unstable; urgency=medium + + * Package git snapshot. + + -- Sean Whitton <spwhitton@spwhitton.name> Fri, 21 Aug 2020 15:37:38 -0700 + emacs-snapshot (28~git20200806.1~bpo10+1~athena1) buster-backports; urgency=medium * Rebuild for athena's apt repository. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index abb385f53d5..0b685fafe9c 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -115,7 +115,7 @@ just like digits. Case is ignored. starting with @kbd{C-x 8}. For example, @kbd{C-x 8 [} inserts @t{‘} which is Unicode code-point U+2018 @sc{left single quotation mark}, sometimes called a left single ``curved quote'' or ``curly quote''. -Similarly, @kbd{C-x 8 ]}, @kbd{C-x 8 @{} and @kbd{C-x 8 @}} insert the +Similarly, @w{@kbd{C-x 8 ]}}, @kbd{C-x 8 @{} and @kbd{C-x 8 @}} insert the curved quotes @t{’}, @t{“} and @t{”}, respectively. Also, a working @key{Alt} key acts like @kbd{C-x 8} (unless followed by @key{RET}); e.g., @kbd{A-[} acts like @kbd{C-x 8 [} and inserts @t{‘}. To see diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi index fe51ad35d77..e5ee7e94bcf 100644 --- a/doc/emacs/calendar.texi +++ b/doc/emacs/calendar.texi @@ -625,6 +625,10 @@ your time zone. Emacs displays the times of sunrise and sunset @emph{corrected for daylight saving time}. @xref{Daylight Saving}, for how daylight saving time is determined. +@vindex calendar-time-zone-style + If you want to display numerical time zones (like @samp{"+0100"}) +instead of symbolic ones (like @samp{"CET"}), set this to @code{numeric}. + As a user, you might find it convenient to set the calendar location variables for your usual physical location in your @file{.emacs} file. If you are a system administrator, you may want to set these variables diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index acd7fb13ae1..a512fd14c80 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -2605,6 +2605,7 @@ the function or facility is available, like this: (if (fboundp 'blink-cursor-mode) (blink-cursor-mode 0)) +@c FIXME: Find better example since `set-coding-priority' is removed. (if (boundp 'coding-category-utf-8) (set-coding-priority '(coding-category-utf-8))) @end example diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 4ff1dc1bd94..de449e31c37 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -694,6 +694,14 @@ The variable @code{dired-recursive-copies} controls whether to copy directories recursively (like @samp{cp -r}). The default is @code{top}, which means to ask before recursively copying a directory. +@vindex dired-copy-dereference +@cindex follow symbolic links +@cindex dereference symbolic links +The variable @code{dired-copy-dereference} controls whether to copy +symbolic links as links or after dereferencing (like @samp{cp -L}). +The default is @code{nil}, which means that the symbolic links are +copied by creating new ones. + @item D @findex dired-do-delete @kindex D @r{(Dired)} diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index e96e43b377d..75ef520d62a 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1334,6 +1334,10 @@ customize the variable @code{whitespace-line-column}. @item newline Highlight newlines. +@item missing-newline-at-eof +Highlight the final character if the buffer doesn't end with a newline +character. + @item empty Highlight empty lines at the beginning and/or end of the buffer. diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 5046146dda6..6633848716e 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -445,12 +445,14 @@ use @code{flyspell-region} or @code{flyspell-buffer} for that. @findex flyspell-correct-word-before-point When Flyspell mode highlights a word as misspelled, you can click on it with @kbd{mouse-2} (@code{flyspell-correct-word}) to display a menu -of possible corrections and actions. In addition, @kbd{C-.} or +of possible corrections and actions. If you want this menu on +@kbd{mouse-3} instead, customize the variable +@code{flyspell-use-mouse-3-for-menu}. In addition, @kbd{C-.} or @kbd{@key{ESC}-@key{TAB}} (@code{flyspell-auto-correct-word}) will propose various successive corrections for the word at point, and -@w{@kbd{C-c $}} (@code{flyspell-correct-word-before-point}) will pop up a -menu of possible corrections. Of course, you can always correct the -misspelled word by editing it manually in any way you like. +@w{@kbd{C-c $}} (@code{flyspell-correct-word-before-point}) will pop +up a menu of possible corrections. Of course, you can always correct +the misspelled word by editing it manually in any way you like. @findex flyspell-prog-mode Flyspell Prog mode works just like ordinary Flyspell mode, except diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index b99d8ab1453..b74887612b9 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -366,9 +366,13 @@ instead of running the @code{mouse-save-then-kill} command, rebind @kbd{mouse-3} by adding the following line to your init file (@pxref{Init Rebinding}): -@c FIXME: `mouse-popup-menubar-stuff' is obsolete since 23.1. @smallexample -(global-set-key [mouse-3] 'mouse-popup-menubar-stuff) +(global-set-key [mouse-3] + '(menu-item "Menu Bar" ignore + :filter (lambda (_) + (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0)) + (mouse-menu-bar-map) + (mouse-menu-major-mode-map))))) @end smallexample @node Mode Line Mouse diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 167c32c4d21..06ad5a583d2 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -220,6 +220,16 @@ documentation string of the command it runs. command is not on any key, that means you must use @kbd{M-x} to run it. @kbd{C-h w} runs the command @code{where-is}. +@findex button-describe +@findex widget-describe + Some modes in Emacs use various buttons (@pxref{Buttons,,,elisp, The +Emacs Lisp Reference Manual}) and widgets +(@pxref{Introduction,,,widget, Emacs Widgets}) that can be clicked to +perform some action. To find out what function is ultimately invoked +by these buttons, Emacs provides the @code{button-describe} and +@code{widget-describe} commands, that should be run with point over +the button. + @node Name Help @section Help by Command or Variable Name diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 43ec2d4e9f2..9f550b49874 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1793,13 +1793,12 @@ for a buffer to switch and considering only the current project's buffers as candidates for completion. @findex project-kill-buffers -@vindex project-kill-buffers-ignores +@vindex project-kill-buffer-conditions When you finish working on the project, you may wish to kill all the buffers that belong to the project, to keep your Emacs session smaller. The command @kbd{C-x p k} (@code{project-kill-buffers}) accomplishes that: it kills all the buffers that belong to the current -project, except if @code{project-kill-buffers-ignores} tells -otherwise. +project that satisfy any of @code{project-kill-buffer-conditions}. @node Switching Projects @subsection Switching Projects diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 55e41e38cb7..54f046a7e05 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -518,6 +518,13 @@ between @samp{foo} and @samp{bar}, that matches @samp{@var{a}foo@var{b}bar@var{c}}, where @var{a}, @var{b}, and @var{c} can be any string including the empty string. +@item flex +@cindex @code{flex}, completion style +This aggressive completion style, also known as @code{flx} or +@code{fuzzy} or @code{scatter} completion, attempts to complete using +in-order substrings. For example, it can consider @samp{foo} to match +@samp{frodo} or @samp{fbarbazoo}. + @item initials @cindex @code{initials}, completion style This very aggressive completion style attempts to complete acronyms diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index e7547ebff7c..c8b21e701c7 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -245,13 +245,13 @@ Do an incremental search on the selected article buffer (@code{gnus-summary-isearch-article}), as if you switched to the buffer and typed @kbd{C-s} (@pxref{Incremental Search}). -@kindex M-s @r{(Gnus Summary mode)} +@kindex M-s M-s @r{(Gnus Summary mode)} @findex gnus-summary-search-article-forward @item M-s @var{regexp} @key{RET} Search forward for articles containing a match for @var{regexp} (@code{gnus-summary-search-article-forward}). -@kindex M-r @r{(Gnus Summary mode)} +@kindex M-s M-r @r{(Gnus Summary mode)} @findex gnus-summary-search-article-backward @item M-r @var{regexp} @key{RET} Search back for articles containing a match for @var{regexp} @@ -724,12 +724,13 @@ See the Eshell Info manual, which is distributed with Emacs. @kindex M-! @findex shell-command +@vindex shell-command-buffer-name @kbd{M-!} (@code{shell-command}) reads a line of text using the minibuffer and executes it as a shell command, in a subshell made just for that command. Standard input for the command comes from the null device. If the shell command produces any output, the output appears -either in the echo area (if it is short), or in an Emacs buffer named -@file{*Shell Command Output*}, displayed in another window (if the +either in the echo area (if it is short), or in the @samp{"*Shell +Command Output*"} (@code{shell-command-buffer-name}) buffer (if the output is long). The variables @code{resize-mini-windows} and @code{max-mini-window-height} (@pxref{Minibuffer Edit}) control when Emacs should consider the output to be too long for the echo area. @@ -758,15 +759,17 @@ which is impossible to ignore. @kindex M-& @findex async-shell-command +@vindex shell-command-buffer-name-async A shell command that ends in @samp{&} is executed @dfn{asynchronously}, and you can continue to use Emacs as it runs. You can also type @kbd{M-&} (@code{async-shell-command}) to execute a shell command asynchronously; this is exactly like calling @kbd{M-!} with a trailing @samp{&}, except that you do not need the @samp{&}. -The default output buffer for asynchronous shell commands is named -@samp{*Async Shell Command*}. Emacs inserts the output into this -buffer as it comes in, whether or not the buffer is visible in a -window. +The output from asynchronous shell commands, by default, goes into the +@samp{"*Async Shell Command*"} buffer +(@code{shell-command-buffer-name-async}). Emacs inserts the output +into this buffer as it comes in, whether or not the buffer is visible +in a window. @vindex async-shell-command-buffer If you want to run more than one asynchronous shell command at the @@ -804,7 +807,7 @@ old region and replaces it with the output from the shell command. see what keys are in the buffer. If the buffer contains a GnuPG key, type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents to @command{gpg}. This will output the list of keys to the -@file{*Shell Command Output*} buffer. +buffer whose name is the value of @code{shell-command-buffer-name}. @vindex shell-file-name The above commands use the shell specified by the variable @@ -2942,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/commands.texi b/doc/lispref/commands.texi index d25f0093618..25f657404f3 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1845,6 +1845,13 @@ is, after a prefix key---then Emacs reorders the events so that this event comes either before or after the multi-event key sequence, not within it. + Some of these special events, such as @code{delete-frame}, invoke +Emacs commands by default; others are not bound. If you want to +arrange for a special event to invoke a command, you can do that via +@code{special-event-map}. The command you bind to a function key in +that map can then examine the full event which invoked it in +@code{last-input-event}. @xref{Special Events}. + @node Event Examples @subsection Event Examples diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index bc8ec0ef1b0..2898cb4d2b4 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -267,7 +267,8 @@ reason functions are defined to start with @code{lambda} is so that other lists, intended for other uses, will not accidentally be valid as functions. - The second element is a list of symbols---the argument variable names. + The second element is a list of symbols---the argument variable +names (@pxref{Argument List}). This is called the @dfn{lambda list}. When a Lisp function is called, the argument values are matched up against the variables in the lambda list, which are given local bindings with the values provided. @@ -342,7 +343,7 @@ stored as symbol function definitions to produce named functions (@pxref{Function Names}). @node Argument List -@subsection Other Features of Argument Lists +@subsection Features of Argument Lists @kindex wrong-number-of-arguments @cindex argument binding @cindex binding arguments @@ -583,8 +584,8 @@ a function. @defmac defun name args [doc] [declare] [interactive] body@dots{} @code{defun} is the usual way to define new Lisp functions. It defines the symbol @var{name} as a function with argument list -@var{args} and body forms given by @var{body}. Neither @var{name} nor -@var{args} should be quoted. +@var{args} (@pxref{Argument List}) and body forms given by @var{body}. +Neither @var{name} nor @var{args} should be quoted. @var{doc}, if present, should be a string specifying the function's documentation string (@pxref{Function Documentation}). @var{declare}, diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 942bda105f7..504f0dfb23e 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2687,9 +2687,9 @@ Emacs is restarted by the session manager. @group (defun save-yourself-test () - (insert "(save-current-buffer - (switch-to-buffer \"*scratch*\") - (insert \"I am restored\"))") + (insert + (format "%S" '(with-current-buffer "*scratch*" + (insert "I am restored")))) nil) @end group @end example diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index d7856ce73e3..91419702ca1 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -411,7 +411,7 @@ function counts that line as one line successfully moved. In an interactive call, @var{count} is the numeric prefix argument. @end deffn -@defun count-lines start end +@defun count-lines start end &optional ignore-invisible-lines @cindex lines in region @anchor{Definition of count-lines} This function returns the number of lines between the positions @@ -420,6 +420,9 @@ This function returns the number of lines between the positions 1, even if @var{start} and @var{end} are on the same line. This is because the text between them, considered in isolation, must contain at least one line unless it is empty. + +If the optional @var{ignore-invisible-lines} is non-@code{nil}, +invisible lines will not be included in the count. @end defun @deffn Command count-words start end diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index c8a12bdd66b..b6242c539b7 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -342,7 +342,7 @@ this choice, the rest of the regexp matches successfully. long time, if they lead to ambiguous matching. For example, trying to match the regular expression @samp{\(x+y*\)*a} against the string @samp{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxz} could -take hours before it ultimately fails. Emacs must try each way of +take hours before it ultimately fails. Emacs may try each way of grouping the @samp{x}s before concluding that none of them can work. In general, avoid expressions that can match the same string in multiple ways. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 91c3049f875..ca52369bd0c 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -791,11 +791,11 @@ use instead of the default @code{equal}. @example @group -(seq-contains '(symbol1 symbol2) 'symbol1) -@result{} symbol1 +(seq-contains-p '(symbol1 symbol2) 'symbol1) +@result{} t @end group @group -(seq-contains '(symbol1 symbol2) 'symbol3) +(seq-contains-p '(symbol1 symbol2) 'symbol3) @result{} nil @end group @end example diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 5b09b2ccea6..1826e8f7b42 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -918,29 +918,56 @@ values. It is much better to convert such comments to documentation strings, though. @item ;;; -Comments that start with three semicolons, @samp{;;;}, should start at -the left margin. We use them -for comments which should be considered a -heading by Outline minor mode. By default, comments starting with -at least three semicolons (followed by a single space and a -non-whitespace character) are considered headings, comments starting -with two or fewer are not. Historically, triple-semicolon comments have -also been used for commenting out lines within a function, but this use -is discouraged. - -When commenting out entire functions, use two semicolons. - -@item ;;;; -Comments that start with four (or more) semicolons, @samp{;;;;}, -should be aligned to the left margin and are used for headings of -major sections of a program. For example: + +Comments that start with three (or more) semicolons, @samp{;;;}, +should start at the left margin. We use them for comments that should +be considered a heading by Outline minor mode. By default, comments +starting with at least three semicolons (followed by a single space +and a non-whitespace character) are considered section headings, +comments starting with two or fewer are not. + +(Historically, triple-semicolon comments have also been used for +commenting out lines within a function, but this use is discouraged in +favor of using just two semicolons. This also applies when commenting +out entire functions; when doing that use two semicolons as well.) + +Three semicolons are used for top-level sections, four for +sub-sections, five for sub-sub-sections and so on. + +Typically libraries have at least four top-level sections. For +example when the bodies of all of these sections are hidden: @smallexample -;;;; The kill ring +@group +;;; backquote.el --- implement the ` Lisp construct... +;;; Commentary:... +;;; Code:... +;;; backquote.el ends here +@end group @end smallexample -If you wish to have sub-headings under these heading, use more -semicolons to nest these sub-headings. +(In a sense the last line is not a section heading as it must +never be followed by any text; after all it marks the end of the +file.) + +For longer libraries it is advisable to split the code into multiple +sections. This can be done by splitting the @samp{Code:} section into +multiple sub-sections. Even though that was the only recommended +approach for a long time, many people have chosen to use multiple +top-level code sections instead. You may chose either style. + +Using multiple top-level code sections has the advantage that it +avoids introducing an additional nesting level but it also means that +the section named @samp{Code} does not contain all the code, which is +awkward. To avoid that, you should put no code at all inside that +section; that way it can be considered a seperator instead of a +section heading. + +Finally, we recommend that you don't end headings with a colon or any +other punctuation for that matter. For historic reasons the +@samp{Code:} and @samp{Commentary:} headings end with a colon, but we +recommend that you don't do the same for other headings anyway. + @end table @noindent diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 82467048a08..3c1244101f4 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3464,7 +3464,6 @@ see @ref{Packages that do not come with Emacs}. @cindex Finding other packages @cindex Lisp packages that do not come with Emacs @cindex Packages, those that do not come with Emacs -@cindex Emacs Lisp List @cindex Emacs Lisp Archive The easiest way to add more features to your Emacs is to use the @@ -3500,10 +3499,6 @@ The @uref{https://emacswiki.org, Emacs Wiki} contains pointers to some additional extensions. @uref{https://wikemacs.org, WikEmacs} is an alternative wiki for Emacs. -@uref{http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.html, The Emacs -Lisp List (ELL)}, has pointers to many Emacs Lisp files, but at time -of writing it is no longer being updated. - It is impossible for us to list here all the sites that offer Emacs Lisp packages. If you are interested in a specific feature, then after checking Emacs itself and GNU ELPA, a web search is often the @@ -4192,7 +4187,7 @@ You can get the old behavior by binding @kbd{SPC} to (define-key minibuffer-local-filename-completion-map (kbd "SPC") 'minibuffer-complete-word) -(define-key minibuffer-local-must-match-filename-map (kbd "SPC") +(define-key minibuffer-local-filename-must-match-map (kbd "SPC") 'minibuffer-complete-word) @end lisp diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index f9901b6fd78..85be112402c 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -52,6 +52,7 @@ modify this GNU manual.'' * Overview:: * Basics:: * Advanced:: +* Command Line:: Appendices * History and Acknowledgments:: @@ -337,6 +338,21 @@ thus allowing for the use of the usual substitutions, such as @code{\[eww-reload]} for the current key binding of the @code{eww-reload} command. +@node Command Line +@chapter Command Line Usage + +It can be convenient to start eww directly from the command line. The +@code{eww-browse} function can be used for that: + +@example +emacs -f eww-browse https://gnu.org +@end example + +This also allows registering Emacs as a @acronym{MIME} handler for the +@samp{"text/x-uri"} media type. How to do that varies between +systems, but typically you'd register the handler to call @samp{"emacs +-f eww-browse %u"}. + @node History and Acknowledgments @appendix History and Acknowledgments diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 584c54674dd..332926a6859 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -11029,14 +11029,14 @@ Go to the Gnus info node (@code{gnus-info-find-node}). @table @kbd -@item M-s -@kindex M-s @r{(Summary)} +@item M-s M-s +@kindex M-s M-s @r{(Summary)} @findex gnus-summary-search-article-forward Search through all subsequent (raw) articles for a regexp (@code{gnus-summary-search-article-forward}). -@item M-r -@kindex M-r @r{(Summary)} +@item M-s M-r +@kindex M-s M-r @r{(Summary)} @findex gnus-summary-search-article-backward Search through all previous (raw) articles for a regexp (@code{gnus-summary-search-article-backward}). diff --git a/doc/misc/message.texi b/doc/misc/message.texi index c9a466eae9f..55b166eb8b0 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -547,7 +547,7 @@ This will start Emacs, and then run the @code{message-mailto} command. It will parse the given @acronym{URL}, and set up a Message buffer with the given parameters. -For instance, @samp{mailto:larsi@@gnus.org;subject=This+is+a+test} +For instance, @samp{mailto:larsi@@gnus.org?subject=This+is+a+test} will open a Message buffer with the @samp{To:} header filled in with @samp{"larsi@@gnus.org"} and the @samp{Subject:} header with @samp{"This is a test"}. @@ -1042,6 +1042,7 @@ and/or encrypted messages as explained in the following. * Signing and encryption:: Signing and encrypting commands. * Using S/MIME:: Using S/MIME * Using OpenPGP:: Using OpenPGP +* OpenPGP Header:: Adding OpenPGP headers to messages. * Passphrase caching:: How to cache passphrases * PGP Compatibility:: Compatibility with older implementations * Encrypt-to-self:: Reading your own encrypted messages @@ -1251,6 +1252,29 @@ according to two different standards, namely @acronym{PGP} or @code{mml-default-sign-method} determine which variant to prefer, @acronym{PGP/MIME} by default. +@node OpenPGP Header +@subsection OpenPGP Header + +The @samp{OpenPGP} header can be used to provide information about the +sender's OpenPGP key. This is a formalization and modernization of +the non-standard @samp{X-PGP-Key} (etc.) headers that have been in use +for a long time. For more details, see +@uref{https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header}. + +@vindex message-openpgp-header +To use this in Message, say: + +@lisp +(add-hook 'message-header-setup-hook 'message-add-openpgp-header) +@end lisp + +@noindent +then customize the @code{message-openpgp-header} variable according to +your PGP setup. The variable is a list of the key ID, the key URL or +ASCII armored key, and the protection preference, one of +@samp{"unprotected"}, @samp{"sign"}, @samp{"encrypt"} or +@samp{"signencrypt"}. + @node Passphrase caching @subsection Passphrase caching diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 56cd220e20e..c1a66d02512 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3378,8 +3378,8 @@ host. Example: @end group @end example -@command{tail} command outputs continuously to the local buffer, -@file{*Async Shell Command*} +@command{tail} command outputs continuously to the local buffer whose +name is the value of the variable @code{shell-command-buffer-name-async}. @kbd{M-x auto-revert-tail-mode @key{RET}} runs similarly showing continuous output. @@ -3561,7 +3561,13 @@ which must be set to a non-@code{nil} value. Example: @end group @end lisp -However, this approach has different limitations: +Using direct asynchronous processes in @value{tramp} is not possible, +if the remote host is connected via multiple hops +(@pxref{Multi-hops}), or the @code{make-process} / +@code{start-file-process} call uses a stderr stream. In this case, +@value{tramp} falls back to its classical implementation. + +Furthermore, this approach has the following limitations: @itemize @item @@ -3569,16 +3575,10 @@ It works only for connection methods defined in @file{tramp-sh.el} and @file{tramp-adb.el}. @item -It does not support multi-hop methods. - -@item It does not support interactive user authentication, like password handling. @item -It does not support a separated error stream. - -@item It cannot be killed via @code{interrupt-process}. @item @@ -3594,7 +3594,10 @@ It does not set environment variable @env{INSIDE_EMACS}. In order to gain even more performance, it is recommended to bind @code{tramp-verbose} to 0 when running @code{make-process} or -@code{start-file-process}. +@code{start-file-process}. Furthermore, you might set +@code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to +bypass @value{tramp}'s handling of the @code{ControlMaster} options, +and use your own settings in @file{~/.ssh/config}. @node Cleanup remote connections diff --git a/doc/misc/url.texi b/doc/misc/url.texi index 8d9b1024070..0304ff4b9f1 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -1312,8 +1312,6 @@ repeated visits do not require repeated domain lookups. @end defopt @defopt url-max-password-attempts @end defopt -@defopt url-temporary-directory -@end defopt @defopt url-show-status @end defopt @defopt url-confirmation-func diff --git a/etc/HISTORY b/etc/HISTORY index f0fd7d6f218..a6b9f57814f 100644 --- a/etc/HISTORY +++ b/etc/HISTORY @@ -220,7 +220,7 @@ GNU Emacs 26.2 (2019-04-12) emacs-26.2 GNU Emacs 26.3 (2019-08-28) emacs-26.3 -GNU Emacs 27.1 (2020-08-06) emacs-27.1 +GNU Emacs 27.1 (2020-08-10) emacs-27.1 ---------------------------------------------------------------------- @@ -80,6 +80,13 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". * Changes in Emacs 28.1 ++++ +** New variables that hold default buffer names for shell output. +The new constants 'shell-command-buffer-name' and +'shell-command-buffer-name-async' store the default buffer names +for the output of, respectively, synchronous and async shell +commands. + ** Support for '(box . SIZE)' 'cursor-type'. By default, 'box' cursor always has a filled box shape. But if you specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow @@ -91,9 +98,20 @@ dimension. Added a new Mozhi scheme. The inapplicable ITRANS scheme is now 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. + * Editing Changes in Emacs 28.1 +--- +** 'eval-expression' now no longer signals an error on incomplete expressions. +Previously, typing 'M-: ( RET' would result in Emacs saying "End of +file during parsing" and dropping out of the minibuffer. The user +would have to type 'M-: M-p' to edit and redo the expression. Now +Emacs will echo the message and allow the user to continue editing. + +++ ** New command 'undo-redo'. It undoes previous undo commands, but doesn't record itself as an @@ -122,6 +140,11 @@ horizontal movements now stop at the edge of the board. ** Autosaving via 'auto-save-visited-mode' can now be inhibited by setting the variable 'auto-save-visited-mode' buffer-locally to nil. +** New commands to describe buttons and widgets have been added. +'widget-describe' (on a widget) will pop up a help buffer and give a +description of the properties. Likewise 'button-describe' does the +same for a button. + * Changes in Specialized Modes and Packages in Emacs 28.1 @@ -175,6 +198,11 @@ and variables. 'archive-hideshow-column'. These let you control which columns are displayed and which are kept hidden. +--- +*** New command bound to 'C': 'archive-copy-file'. +This command extracts the file under point and writes the data to a +file. + ** Emacs Lisp mode *** The mode-line now indicates whether we're using lexical or dynamic scoping. @@ -184,8 +212,21 @@ The presence of a space between an open paren and a symbol now is taken as a statement by the programmer that this should be indented as a data list rather than as a piece of code. +** Calendar + ++++ +*** New user option 'calendar-time-zone-style'. +If 'numeric', calendar functions (eg 'calendar-sunrise-sunset') that display +time zones will use a form like "+0100" instead of "CET". + ** Dired ++++ +*** 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 +'dired-do-copy' with a 'C-u' prefix. + *** New user option 'dired-mark-region' affects all Dired commands that mark files. When non-nil and the region is active in Transient Mark mode, then Dired commands operate only on files in the active @@ -210,8 +251,29 @@ their 'default-directory' under VC. *** Support for bookmark.el. Bookmark locations can refer to VC directory buffers. +--- +*** New user option 'vc-hg-create-bookmark'. +It controls whether a bookmark or branch will be created when you +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'. +If non-nil, only branches and remotes are considered when doing +completion over Git branch names. The default is nil, which causes +tags to be considered as well. + ** Gnus ++++ +*** The key binding of 'gnus-summary-search-article-forward' has changed. +This command was previously on 'M-s' and shadowed the global 'M-s' +search prefix. The command has now been moved to 'M-s M-s'. (For +consistency, the 'M-s M-r' key binding has been added for the +'gnus-summary-search-article-backward' command.) + --- *** The value of "all" in the 'large-newsgroup-initial' group parameter changes. It was previously nil, which didn't work, because nil is @@ -236,25 +298,31 @@ not. ** Message ++++ +*** Message now supports the OpenPGP header. +To generate these headers, add the new function +'message-add-openpgp-header' to 'message-send-hook'. The header will +be generated according to the new 'message-openpgp-header' variable. + --- -*** A change to how Mail-Copies-To: never is handled. -If a user has specified Mail-Copies-To: never, and Message was asked +*** A change to how "Mail-Copies-To: never" is handled. +If a user has specified "Mail-Copies-To: never", and Message was asked to do a "wide reply", some other arbitrary recipient would end up in -the resulting To header, while the remaining recipients would be put -in the Cc header. This is somewhat misleading, as it looks like +the resulting "To" header, while the remaining recipients would be put +in the "Cc" header. This is somewhat misleading, as it looks like you're responding to a specific person in particular. This has been -changed so that all the recipients are put in the To header in these +changed so that all the recipients are put in the "To" header in these instances. +++ *** New function to start Emacs in Message mode to send an email. Emacs can be defined as a handler for the "x-scheme-handler/mailto" MIME type with the following command: "emacs -f message-mailto %u". -An emacs-mail.desktop file has been included, suitable for installing -in desktop directories like /usr/share/applications. Clicking on a -mailto: link in other applications will then open Emacs with headers -filled out according to the link, e.g. -"mailto:larsi@gnus.org;subject=This+is+a+test". +An "emacs-mail.desktop" file has been included, suitable for +installing in desktop directories like "/usr/share/applications". +Clicking on a 'mailto:' link in other applications will then open +Emacs with headers filled out according to the link, e.g. +"mailto:larsi@gnus.org?subject=This+is+a+test". --- *** Change to default value of 'message-draft-headers' user option. @@ -268,7 +336,7 @@ this user option. *** New command to take screenshots. In Message mode buffers, the 'C-c C-p' ('message-insert-screenshot') command has been added. It depends on using an external program to -take the actual screenshot, and defaults to ImageMagick "import". +take the actual screenshot, and defaults to "ImageMagick import". ** Help @@ -289,7 +357,7 @@ This file was a compatibility kludge which is no longer needed. --- ** Lisp mode now uses 'common-lisp-indent-function'. -To revert to the previous behaviour, +To revert to the previous behavior, '(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'. ** Edebug @@ -397,7 +465,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'. @@ -435,7 +503,7 @@ Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options. *** Regexp matching of messages is now case-sensitive by default. The variable 'compilation-error-case-fold-search' can be set for -case-insensitive matching of messages when the old behaviour is +case-insensitive matching of messages when the old behavior is required, but the recommended solution is to use a correctly matching regexp instead. @@ -451,12 +519,28 @@ to substitute spaces in regexp search. *** The default value of 'hi-lock-highlight-range' was enlarged. The new default value is 2000000 (2 megabytes). +** Whitespace mode + ++++ +*** New style 'missing-newline-at-eof'. +If present in 'whitespace-style' (as it is by default), the final +character in the buffer will be highlighted if the buffer doesn't end +with a newline. + ** Texinfo --- *** New user option 'texinfo-texi2dvi-options'. This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'. +--- +*** New commands for moving in and between environments. +An "environment" is something that ends with '@end'. The commands are +'C-c C-c C-f' (next end), 'C-c C-c C-b' (previous end), +'C-c C-c C-n' (next start) and 'C-c C-c C-p' (previous start), as well +as 'C-c .', which will alternate between the start and the end of the +current environment. + ** Rmail --- @@ -470,6 +554,9 @@ prefix on the Subject line in various languages. These new navigation commands are bound to 'n' and 'p' in 'apropos-mode'. +*** New command 'apropos-function'. +This works like 'C-u M-x apropos-command' but is more discoverable. + ** CC Mode *** Added support for Doxygen documentation style. @@ -529,6 +616,9 @@ either an internal or external browser. *** Support for the conkeror browser is now obsolete. +*** Support for the Mosaic browser has been removed. +This support has been obsolete since 25.1. + ** SHR --- @@ -570,6 +660,12 @@ mode buffer. ** EWW +++ +*** New Emacs command line convenience function. +The 'eww-browse' command has been added, which allows you to register +Emacs as a MIME handler for "text/x-uri", and will call 'eww' on the +supplied URL. Usage example: "emacs -f eww-browse https://gnu.org". + ++++ *** 'eww-download-directory' will now use the XDG location, if defined. However, if "~/Downloads/" already exists, that will continue to be used. @@ -630,9 +726,25 @@ https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. ** erc --- -*** The /ignore command will now ask for a timeout to stop ignoring the user. +*** The '/ignore' command will now ask for a timeout to stop ignoring the user. Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m". +--- +*** ERC now recognizes 'C-]' for italic text. +Italic text is displayed in the new 'erc-italic-face'. + +--- +*** The erc-compat.el library is now marked obsolete. +This file contained ERC compatibility code for Emacs 21 and XEmacs +which is no longer needed. + +--- +*** erc-match.el now supports 'message' highlight type (not including the nick). +The 'erc-current-nick-highlight-type', 'erc-pal-highlight-type', +'erc-fool-highlight-type', 'erc-keyword-highlight-type', and +'erc-dangerous-host-highlight-type' variables now support a 'message' +type for highlighting the entire message but not the sender's nick. + ** Battery --- @@ -676,6 +788,148 @@ custom rules, see the variables 'bug-reference-setup-from-vc-alist', It's bound to the 'C-c C-c f' keystroke, and prompts for a local file name. +--- +** Recentf +The recentf files are no longer backed up. + +** Calc + +--- +*** The behavior when doing forward-delete has been changed. +Previously, using the 'C-d' command would delete the final number in +the input field, no matter where point was. This has been changed to +work more traditionally, with 'C-d' deleting the next character. +Likewise, point isn't moved to the end of the string before inserting +digits. + +** term-mode + +--- +*** New user option 'term-scroll-snap-to-bottom'. +By default, 'term' and 'ansi-term' will now recenter the buffer so +that the prompt is on the final line in the window. Setting this new +user option to nil inhibits this behavior. + +--- +*** New user option 'term-set-terminal-size' +If non-nil, the 'LINES' and 'COLUMNS' environment variables will be set +based on the current window size. In previous versions of Emacs, this +was always done (and that could lead to odd displays when resizing the +window after starting). This variable defaults to nil. + + +** Miscellaneous + ++++ +*** 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. +This was lost in Emacs 24, but is now back again. + +--- +*** 'M-x report-emacs-bug' will no longer include "Recent messages" section. +These were taken from the "*Messages*" buffer, and may inadvertently +leak information from the reporting user. + +--- +*** 'count-windows' now takes an optional parameter ALL-FRAMES. +The semantics are as with 'walk-windows'. + +--- +*** Killing virtual ido buffers interactively will make them go away. +Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't +do anything. This has now been changed, and killing virtual buffers +with that command will remove the buffer from recentf. + +--- +*** New variable 'ffap-file-name-with-spaces'. +If non-nil, 'find-file-at-point' and friends will try to guess more +expansively to identify a file name with spaces. + +--- +*** Two new commands for centering in 'doc-view-mode'. +The new commands 'doc-view-center-page-horizontally' (bound to 'c h') +and 'doc-view-center-page-vertically' (bound to 'c v') center the page +horizontally and vertically, respectively. + +--- +*** Change in meaning of 'icomplete-show-matches-on-no-input'. +Previously, choosing a different completion with commands like 'C-.' +and then hitting 'RET' would choose the default completion. Doing this +will now choose the completion under point instead. + +--- +*** The width of the buffer-name column in 'list-buffers' is now dynamic. +The width now depends of the width of the window, but will never be +wider than the length of the longest buffer name, except that it will +never be narrower than 19 characters. + +*** Bookmarks can now be targets for new tabs. +When the bookmark.el library is loaded, a customize choice is added +to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list. + + +** xwidget-webkit mode + +*** New xwidget functions. +'xwidget-webkit-uri' (return the current URL), 'xwidget-webkit-title' +(return the current title), and 'xwidget-webkit-goto-history' (goto a +point in history). + +*** Pixel-based scrolling. +The 'xwidget-webkit-scroll-up', 'xwidget-webkit-scroll-down' commands +now supports scrolling arbitrary pixel values. It now treats the +optional 2nd argument as the pixel values to scroll. + +*** New commands for scrolling. +The new commands 'xwidget-webkit-scroll-up-line', +'xwidget-webkit-scroll-down-line', 'xwidget-webkit-scroll-forward', +'xwidget-webkit-scroll-backward' can be used to scroll webkit by the +height of lines or width of chars. + +*** New user option 'xwidget-webkit-bookmark-jump-new-session'. +When non-nil, use a new xwidget webkit session after bookmark jump. +Otherwise, it will use 'xwidget-webkit-last-session'. + +** Flyspell mode + ++++ +*** Corrections and actions menu can be optionally bound to 'mouse-3'. +When Flyspell mode highlights a word as misspelled, you can click on +it to display a menu of possible corrections and actions. You can now +easily bind this menu to 'down-mouse-3' (usually the right mouse button) +instead of 'mouse-2' (the default) by customizing the new user option +'flyspell-use-mouse-3-for-menu'. + +** Time + +--- +*** 'display-time-world' has been renamed to 'world-clock'. +'world-clock' creates a buffer with an updating time display using +several time zones. It is hoped that the new names are more +discoverable. + +The following functions have been renamed: + + 'display-time-world' to 'world-clock' + 'display-time-world-mode' to 'world-clock-mode' + 'display-time-world-display' to 'world-clock-display' + 'display-time-world-timer' to 'world-clock-update' + +The following user options have been renamed: + + 'display-time-world-list' to 'world-clock-list' + 'display-time-world-time-format' to 'world-clock-time-format' + 'display-time-world-buffer-name' to 'world-clock-buffer-name' + 'display-time-world-timer-enable' to 'world-clock-timer-enable' + 'display-time-world-timer-second' to 'world-clock-timer-second' + +The old names are now obsolete. + * New Modes and Packages in Emacs 28.1 @@ -686,6 +940,10 @@ composed of Lisp symbolic expressions that do not form a computer program. The ".dir-locals.el" file is automatically set to use this mode, as are other data files produced by Emacs. +** hierarchy.el + +It's a library to create, query, navigate and display hierarchy structures. + * Incompatible Editing Changes in Emacs 28.1 @@ -748,12 +1006,61 @@ have now been removed. --- ** Some libraries obsolete since Emacs 23 have been removed: -'ledit.el', 'lmenu.el', 'lucid.el and 'old-whitespace.el'. +ledit.el, lmenu.el, lucid.el and old-whitespace.el. + +--- +** Some functions and variables obsolete since Emacs 23 have been removed: + +'GOLD-map', 'bookmark-jump-noselect', +'bookmark-read-annotation-text-func', 'buffer-menu-mode-hook', +'char-coding-system-table', 'char-valid-p', 'charset-bytes', +'charset-id', 'charset-list' (function), 'complete-in-turn', +'completion-common-substring', 'crm-minibuffer-complete', +'crm-minibuffer-complete-and-exit', 'crm-minibuffer-completion-help', +'custom-mode', 'custom-mode-hook', 'detect-coding-with-priority', +'dirtrack-debug' (function), 'dirtrack-debug-toggle', +'dynamic-completion-table', +'easy-menu-precalculate-equivalent-keybindings', +'epa-display-verify-result', 'epg-passphrase-callback-function', +'eshell-report-bug', 'ffap-bug', 'ffap-submit-bug', 'forward-point', +'generic-char-p', 'global-highlight-changes', 'hi-lock-face-history', +'hi-lock-regexp-history', 'highlight-changes-active-string', +'highlight-changes-initial-state', 'highlight-changes-passive-string', +'ispell-aspell-supports-utf8', 'lisp-mode-auto-fill', +'locate-file-completion', 'make-coding-system', +'minibuffer-local-must-match-filename-map', 'mouse-major-mode-menu', +'mouse-popup-menubar', 'mouse-popup-menubar-stuff', +'newsticker-groups-filename', 'non-iso-charset-alist', +'nonascii-insert-offset', 'nonascii-translation-table', +'password-read-and-add', 'pre-abbrev-expand-hook', +'process-filter-multibyte-p', 'remember-buffer' (function), +'rmail-message-filter', 'set-coding-priority', +'set-process-filter-multibyte', 'shell-dirtrack-toggle', +'t-mouse-mode', 'tooltip-hook', 'tpu-have-ispell', +'url-generate-unique-filename', 'url-temporary-directory', +'vc-arch-command', 'vc-default-working-revision' (variable), +'vc-mtn-command', 'vc-revert-buffer', 'vc-workfile-version', +'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font'. * Lisp Changes in Emacs 28.1 +++ +** The 'count-lines' function now takes an optional parameter to +ignore invisible lines. + +--- +** 'count-words' now crosses field boundaries. +Originally, 'count-words' would stop counting at the first field +boundary it encountered; now it keeps counting all the way to the +region's (or buffer's) end. + +--- +** New function 'custom-add-choice'. +This function can be used by modes to add elements to the +'choice' customization type of a variable. + ++++ ** New function 'file-modes-number-to-symbolic' to convert a numeric file mode specification into symbolic form. @@ -834,6 +1141,21 @@ convert them to a list '(R G B)' of primary color values. * Changes in Emacs 28.1 on Non-Free Operating Systems +--- +** On macOS, Xwidget is now supported. +If Emacs was built with xwidget support, you can access the embedded +webkit browser with 'M-x xwidget-webkit-browse-url'. Viewing two +instances of xwidget webkit is not supported. + +*** Downloading files from xwidget-webkit is now supported. +The new variable 'xwidget-webkit-download-dir' says where to download to. + +*** New functions for xwidget-webkit mode +'xwidget-webkit-clone-and-split-below', +'xwidget-webkit-clone-and-split-right'. + +*** New variable 'xwidget-webkit-enable-plugins'. + +++ ** On macOS, Emacs can now load dynamic modules with a ".dylib" suffix. 'module-file-suffix' now has the value ".dylib" on macOS, but the diff --git a/etc/NEWS.27 b/etc/NEWS.27 index a056f5c1e82..31b69025173 100644 --- a/etc/NEWS.27 +++ b/etc/NEWS.27 @@ -202,10 +202,11 @@ it won't work right without some adjustment: ** Emacs now notifies systemd when startup finishes or shutdown begins. Units that are ordered after 'emacs.service' will only be started -after Emacs has finished initialization and is ready for use. -(If your Emacs is installed in a non-standard location and you copied the -emacs.service file to e.g. "~/.config/systemd/user/", you will need to copy -the new version of the file again.) +after Emacs has finished initialization and is ready for use, and +Emacs needs to be built with systemd support. (If your Emacs is +installed in a non-standard location and you copied the emacs.service +file to e.g. "~/.config/systemd/user/", you will need to copy the new +version of the file again.) * Changes in Emacs 27.1 @@ -595,7 +596,7 @@ the node "(emacs) Directory Variables" of the user manual. ** Network connections using 'local' can now use IPv6. 'make-network-process' now uses the correct loopback address when -asked to use ':host 'local' and ':family 'ipv6'. +asked to use ":host 'local" and ":family 'ipv6". ** The new function 'replace-region-contents' replaces the current region using a given replacement-function in a non-destructive manner @@ -1917,6 +1918,11 @@ The value of the new 'sender' slot (if a string) is used to set gpg's 'mml-secure-openpgp-sign-with-sender'. See gpg(1) manual page about "--sender" for more information. +*** 'epg-find-configuration' no longer finds GnuPG 2.0 through 2.1.5. +Previously, it found these versions by mistake. The intent was to +find GnuPG 2.1.6 or later, or find GnuPG 1.4.3 or later within the +GnuPG 1 series. + ** Rmail *** New user option 'rmail-output-reset-deleted-flag'. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 598a79f978a..f68a183c5d7 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -419,27 +419,6 @@ EMACSLOADPATH overrides which directories the function "load" will search. If you observe strange problems, check for this variable in your environment. -*** Using epop3.el package causes Emacs to signal an error. - -The error message might be something like this: - - "Lisp nesting exceeds max-lisp-eval-depth" - -This happens because epop3 redefines the function gethash, which is a -built-in primitive beginning with Emacs 21.1. We don't have a patch -for epop3 to fix it, but perhaps a newer version of epop3 corrects that. - -*** Buffers from 'with-output-to-temp-buffer' get set up in Help mode. - -Changes in Emacs 20.4 to the hooks used by that function cause -problems for some packages, specifically BBDB. See the function's -documentation for the hooks involved. BBDB 2.00.06 fixes the problem. - -*** The Hyperbole package causes *Help* buffers not to be displayed in -Help mode due to setting 'temp-buffer-show-hook' rather than using -'add-hook'. Using '(add-hook 'temp-buffer-show-hook 'help-mode-finish)' -after loading Hyperbole should fix this. - ** Keyboard problems *** Unable to enter the M-| key on some German keyboards. @@ -575,13 +554,6 @@ For example, simply moving through a file that contains hundreds of thousands of characters per line is slow, and consumes a lot of CPU. This is a known limitation of Emacs with no solution at this time. -*** Emacs uses 100% of CPU time - -This was a known problem with some old versions of the Semantic package. -The solution was to upgrade Semantic to version 2.0pre4 (distributed -with CEDET 1.0pre4) or later. Note that Emacs includes Semantic since -23.2, and this issue does not apply to the included version. - *** Display artifacts on GUI frames on X-based systems. This is known to be caused by using double-buffering (which is enabled @@ -1952,11 +1924,6 @@ A few versions of the Linux kernel have timer bugs that break CPU profiling; see Bug#34235. To fix the problem, upgrade to one of the kernel versions 4.14.97, 4.19.19, or 4.20.6, or later. -*** GNU/Linux: Process output is corrupted. - -There is a bug in Linux kernel 2.6.10 PTYs that can cause emacs to -read corrupted process output. - *** GNU/Linux: Remote access to CVS with SSH causes file corruption. If you access a remote CVS repository via SSH, files may be corrupted @@ -2740,11 +2707,6 @@ library on these systems. The solution is to reconfigure Emacs while disabling all the features that require libgio: rsvg, dbus, gconf, and imagemagick. -*** Building Emacs for Cygwin can fail with GCC 3 - -As of Emacs 22.1, there have been stability problems with Cygwin -builds of Emacs using GCC 3. Cygwin users are advised to use GCC 4. - *** Building Emacs 23.3 and later will fail under Cygwin 1.5.19 This is a consequence of a change to src/dired.c on 2010-07-27. The diff --git a/etc/emacs.service b/etc/emacs.service index c99c6779f58..0dc2418269e 100644 --- a/etc/emacs.service +++ b/etc/emacs.service @@ -8,7 +8,7 @@ Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/ [Service] Type=notify -ExecStart=emacs --fg-daemon +ExecStart=@emacs emacsd --fg-daemon ExecStop=emacsclient --eval "(kill-emacs)" # The location of the SSH auth socket varies by distribution, and some # set it from PAM, so don't override by default. diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop new file mode 100644 index 00000000000..3feb83c7290 --- /dev/null +++ b/etc/emacsclient.desktop @@ -0,0 +1,12 @@ +[Desktop Entry] +Name=Emacs (Client) +GenericName=Text Editor +Comment=Edit text +MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++; +Exec=emacsclient -c %F +Icon=emacs +Type=Application +Terminal=false +Categories=Development;TextEditor; +StartupWMClass=Emacsd +Keywords=Text;Editor; diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index c298b536d2d..f104c845ff6 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -4,7 +4,7 @@ ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> ;; URL: https://github.com/fniessen/emacs-leuven-theme -;; Version: 20200425.0837 +;; Version: 20200513.1928 ;; Keywords: color theme ;; This file is part of GNU Emacs. @@ -31,42 +31,98 @@ ;; ;; (load-theme 'leuven t) ;; -;; Requirements: Emacs 24. +;; Requirements: Emacs 24+. +;; +;; NOTE -- Would you like implement a version of this for dark backgrounds, +;; please do so! I'm willing to integrate it... ;;; Code: +;;; Options. + +(defgroup leuven nil + "Leuven theme options. +The theme has to be reloaded after changing anything in this group." + :group 'faces) + +(defcustom leuven-scale-outline-headlines t + "Scale `outline' (and `org') level-1 headlines. +This can be nil for unscaled, t for using the theme default, or a scaling +number." + :type '(choice + (const :tag "Unscaled" nil) + (const :tag "Default provided by theme" t) + (number :tag "Set scaling")) + :group 'leuven) + +(defcustom leuven-scale-org-agenda-structure t + "Scale Org agenda structure lines, like dates. +This can be nil for unscaled, t for using the theme default, or a scaling +number." + :type '(choice + (const :tag "Unscaled" nil) + (const :tag "Default provided by theme" t) + (number :tag "Set scaling"))) + +(defun leuven-scale-font (control default-height) + "Function for splicing optional font heights into face descriptions. +CONTROL can be a number, nil, or t. When t, use DEFAULT-HEIGHT." + (cond + ((numberp control) (list :height control)) + ((eq t control) (list :height default-height)) + (t nil))) + +;;; Theme Faces. + (deftheme leuven "Face colors with a light background. -Basic, Font Lock, Isearch, Gnus, Message, Diff, Ediff, Flyspell, -Semantic, and Ansi-Color faces are included -- and much more...") +Basic, Font Lock, Isearch, Gnus, Message, Org mode, Diff, Ediff, +Flyspell, Semantic, and Ansi-Color faces are included -- and much +more...") (let ((class '((class color) (min-colors 89))) - ;; Leuven generic colors - (cancel '(:slant italic :strike-through t :foreground "gray55")) + ;; Leuven generic colors. + (cancel '(:slant italic :strike-through t :foreground "#A9A9A9")) (clock-line '(:box (:line-width 1 :color "#335EA8") :foreground "black" :background "#EEC900")) (code-block '(:foreground "#000088" :background "#FFFFE0")) (code-inline '(:foreground "#006400" :background "#FDFFF7")) (column '(:height 1.0 :weight normal :slant normal :underline nil :strike-through nil :foreground "#E6AD4F" :background "#FFF2DE")) - (diff-added '(:foreground "#008000" :background "#DDFFDD")) + (completion-inline '(:weight normal :foreground "#C0C0C0" :inherit hl-line)) ; Like Google. + (completion-other-candidates '(:weight bold :foreground "black" :background "#EBF4FE")) + (completion-selected-candidate '(:weight bold :foreground "white" :background "#0052A4")) + (diff-added '(:background "#DDFFDD")) (diff-changed '(:foreground "#0000FF" :background "#DDDDFF")) - (diff-header '(:foreground "#800000" :background "#FFFFAF")) + (diff-header '(:weight bold :foreground "#800000" :background "#FFFFAF")) (diff-hunk-header '(:foreground "#990099" :background "#FFEEFF")) - (diff-none '(:foreground "gray33")) - (diff-removed '(:foreground "#A60000" :background "#FFDDDD")) + (diff-none '(:foreground "#888888")) + (diff-refine-added '(:background "#97F295")) + (diff-refine-removed '(:background "#FFB6BA")) + (diff-removed '(:background "#FEE8E9")) (directory '(:weight bold :foreground "blue" :background "#FFFFD2")) - (highlight-line '(:background "#FFFFD7")) ; #F5F5F5 - (highlight-line-gnus '(:background "#DAEAFC")) ; defined in `gnus-leuven.el' + (file '(:foreground "black")) + (function-param '(:foreground "#247284")) + (grep-file-name '(:weight bold :foreground "#2A489E")) ; Used for grep hits. + (grep-line-number '(:weight bold :foreground "#A535AE")) + (highlight-blue '(:background "#E6ECFF")) + (highlight-blue2 '(:background "#E4F1F9")) + (highlight-gray '(:background "#E4E4E3")) + (highlight-green '(:background "#D5F1CF")) + (highlight-red '(:background "#FFC8C8")) + (highlight-yellow '(:background "#F6FECD")) (link '(:weight normal :underline t :foreground "#006DAF")) + (link-no-underline '(:weight normal :foreground "#006DAF")) (mail-header-name '(:family "Sans Serif" :weight normal :foreground "#A3A3A2")) (mail-header-other '(:family "Sans Serif" :slant normal :foreground "#666666")) - (mail-read '(:weight normal :foreground "#86878B")) - (mail-ticked '(:weight bold :background "#FBE6EF")) + (mail-read '(:foreground "#8C8C8C")) + (mail-read-high '(:foreground "#808080")) + (mail-ticked '(:foreground "#FF3300")) (mail-to '(:family "Sans Serif" :underline nil :foreground "#006DAF")) - (mail-unread '(:weight bold :foreground "black")) - (marked-line '(:weight bold :foreground "white" :background "red")) - (match '(:weight bold :background "#FBE448")) ; occur patterns - (ol1 '(:height 1.3 :weight bold :overline "#A7A7A7" :foreground "#3C3C3C" :background "#F0F0F0")) + (mail-unread '(:weight bold :foreground "#000000")) + (mail-unread-high '(:weight bold :foreground "#135985")) + (marked-line '(:foreground "#AA0000" :background "#FFAAAA")) + (match '(:weight bold :background "#FFFF00")) ; occur patterns + match in helm for files + match in Org files. + (ol1 `(,@(leuven-scale-font leuven-scale-outline-headlines 1.3) :weight bold :overline "#A7A7A7" :foreground "#3C3C3C" :background "#F0F0F0")) (ol2 '(:height 1.0 :weight bold :overline "#123555" :foreground "#123555" :background "#E5F4FB")) (ol3 '(:height 1.0 :weight bold :foreground "#005522" :background "#EFFFEF")) (ol4 '(:height 1.0 :weight bold :slant normal :foreground "#EA6300")) @@ -74,15 +130,22 @@ Semantic, and Ansi-Color faces are included -- and much more...") (ol6 '(:height 1.0 :weight bold :slant italic :foreground "#0077CC")) (ol7 '(:height 1.0 :weight bold :slant italic :foreground "#2EAE2C")) (ol8 '(:height 1.0 :weight bold :slant italic :foreground "#FD8008")) - (paren-matched '(:background "#99CCFF")) - (paren-unmatched '(:underline "red" :foreground nil :background "#FFDCDC")) - (region '(:background "#ABDFFA")) + (paren-matched '(:background "#C0E8C3")) ; Or take that green for region? + (paren-unmatched '(:weight bold :underline "red" :foreground "black" :background "#FFA5A5")) + (region '(:background "#8ED3FF")) (shadow '(:foreground "#7F7F7F")) (string '(:foreground "#008000")) ; or #D0372D (subject '(:family "Sans Serif" :weight bold :foreground "black")) - (symlink '(:foreground "deep sky blue")) - (volatile-highlight '(:underline nil :background "#FFF876")) - (vc-branch '(:box (:line-width 1 :color "#00CC33") :foreground "black" :background "#AAFFAA"))) + (symlink '(:foreground "#1F8DD6")) + (tab '(:foreground "#E8E8E8" :background "white")) + (trailing '(:foreground "#E8E8E8" :background "#FFFFAB")) + (volatile-highlight '(:underline nil :foreground "white" :background "#9E3699")) + (volatile-highlight-supersize '(:height 1.1 :underline nil :foreground "white" :background "#9E3699")) ; flash-region + (vc-branch '(:box (:line-width 1 :color "#00CC33") :foreground "black" :background "#AAFFAA")) + (xml-attribute '(:foreground "#F36335")) + (xml-tag '(:foreground "#AE1B9A")) + (highlight-current-tag '(:background "#E8E8FF")) ; #EEF3F6 or #FFEB26 + ) (custom-theme-set-faces 'leuven @@ -91,40 +154,43 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(bold-italic ((,class (:weight bold :slant italic :foreground "black")))) `(italic ((,class (:slant italic :foreground "#1A1A1A")))) `(underline ((,class (:underline t)))) - `(cursor ((,class (:background "#0FB300")))) + `(cursor ((,class (:background "#21BDFF")))) + + ;; Lucid toolkit emacs menus. + `(menu ((,class (:foreground "#FFFFFF" :background "#333333")))) - ;; Highlighting faces - `(fringe ((,class (:foreground "#9B9B9B" :background "#EDEDED")))) - `(highlight ((,class ,volatile-highlight))) + ;; Highlighting faces. + `(fringe ((,class (:foreground "#4C9ED9" :background "white")))) + `(highlight ((,class ,highlight-blue))) `(region ((,class ,region))) - `(secondary-selection ((,class ,match))) ; used by Org-mode for highlighting matched entries and keywords - `(isearch ((,class (:weight bold :underline "#FF9632" :foreground nil :background "#FDBD33")))) - `(isearch-fail ((,class (:weight bold :foreground "black" :background "#FF9999")))) - `(lazy-highlight ((,class (:underline "#FF9632" :background "#FFFF00")))) ; isearch others - `(trailing-whitespace ((,class (:background "#FFFF57")))) - `(whitespace-hspace ((,class (:foreground "#D2D2D2")))) - `(whitespace-indentation ((,class (:foreground "#A1A1A1" :background "white")))) + `(secondary-selection ((,class ,match))) ; Used by Org-mode for highlighting matched entries and keywords. + `(isearch ((,class (:underline "black" :foreground "white" :background "#5974AB")))) + `(isearch-fail ((,class (:weight bold :foreground "black" :background "#FFCCCC")))) + `(lazy-highlight ((,class (:foreground "black" :background "#FFFF00")))) ; Isearch others (see `match'). + `(trailing-whitespace ((,class ,trailing))) + `(query-replace ((,class (:inherit isearch)))) + `(whitespace-hspace ((,class (:foreground "#D2D2D2")))) ; see also `nobreak-space' + `(whitespace-indentation ((,class ,tab))) `(whitespace-line ((,class (:foreground "#CC0000" :background "#FFFF88")))) - `(whitespace-tab ((,class (:foreground "#A1A1A1" :background "white")))) - `(whitespace-trailing ((,class (:foreground "#B3B3B3" :background "#FFFF57")))) + `(whitespace-tab ((,class ,tab))) + `(whitespace-trailing ((,class ,trailing))) - ;; Mode line faces + ;; Mode line faces. `(mode-line ((,class (:box (:line-width 1 :color "#1A2F54") :foreground "#85CEEB" :background "#335EA8")))) `(mode-line-inactive ((,class (:box (:line-width 1 :color "#4E4E4C") :foreground "#F0F0EF" :background "#9B9C97")))) `(mode-line-buffer-id ((,class (:weight bold :foreground "white")))) `(mode-line-emphasis ((,class (:weight bold :foreground "white")))) `(mode-line-highlight ((,class (:foreground "yellow")))) - ;; Escape and prompt faces + ;; Escape and prompt faces. `(minibuffer-prompt ((,class (:weight bold :foreground "black" :background "gold")))) `(minibuffer-noticeable-prompt ((,class (:weight bold :foreground "black" :background "gold")))) `(escape-glyph ((,class (:foreground "#008ED1")))) - `(homoglyph ((,class (:foreground "#008ED1")))) `(error ((,class (:foreground "red")))) `(warning ((,class (:weight bold :foreground "orange")))) `(success ((,class (:foreground "green")))) - ;; Font lock faces + ;; Font lock faces. `(font-lock-builtin-face ((,class (:foreground "#006FE0")))) `(font-lock-comment-delimiter-face ((,class (:foreground "#8D8D84")))) ; #696969 `(font-lock-comment-face ((,class (:slant italic :foreground "#8D8D84")))) ; #696969 @@ -140,32 +206,32 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(font-lock-variable-name-face ((,class (:weight normal :foreground "#BA36A5")))) ; #800080 `(font-lock-warning-face ((,class (:weight bold :foreground "red")))) - ;; Button and link faces + ;; Button and link faces. `(link ((,class ,link))) `(link-visited ((,class (:underline t :foreground "#E5786D")))) `(button ((,class (:underline t :foreground "#006DAF")))) - `(header-line ((,class (:weight bold :underline "black" :overline "black" :foreground "black" :background "#FFFF88")))) + `(header-line ((,class (:box (:line-width 1 :color "black") :foreground "black" :background "#F0F0F0")))) - ;; Gnus faces + ;; Gnus faces. `(gnus-button ((,class (:weight normal)))) `(gnus-cite-attribution-face ((,class (:foreground "#5050B0")))) - `(gnus-cite-face-1 ((,class (:foreground "#5050B0")))) - `(gnus-cite-face-10 ((,class (:foreground "#990000")))) - `(gnus-cite-face-2 ((,class (:foreground "#660066")))) - `(gnus-cite-face-3 ((,class (:foreground "#007777")))) - `(gnus-cite-face-4 ((,class (:foreground "#990000")))) - `(gnus-cite-face-5 ((,class (:foreground "#000099")))) - `(gnus-cite-face-6 ((,class (:foreground "#BB6600")))) - `(gnus-cite-face-7 ((,class (:foreground "#5050B0")))) - `(gnus-cite-face-8 ((,class (:foreground "#660066")))) - `(gnus-cite-face-9 ((,class (:foreground "#007777")))) + `(gnus-cite-1 ((,class (:foreground "#5050B0" :background "#F6F6F6")))) + `(gnus-cite-2 ((,class (:foreground "#660066" :background "#F6F6F6")))) + `(gnus-cite-3 ((,class (:foreground "#007777" :background "#F6F6F6")))) + `(gnus-cite-4 ((,class (:foreground "#990000" :background "#F6F6F6")))) + `(gnus-cite-5 ((,class (:foreground "#000099" :background "#F6F6F6")))) + `(gnus-cite-6 ((,class (:foreground "#BB6600" :background "#F6F6F6")))) + `(gnus-cite-7 ((,class (:foreground "#5050B0" :background "#F6F6F6")))) + `(gnus-cite-8 ((,class (:foreground "#660066" :background "#F6F6F6")))) + `(gnus-cite-9 ((,class (:foreground "#007777" :background "#F6F6F6")))) + `(gnus-cite-10 ((,class (:foreground "#990000" :background "#F6F6F6")))) `(gnus-emphasis-bold ((,class (:weight bold)))) `(gnus-emphasis-highlight-words ((,class (:foreground "yellow" :background "black")))) `(gnus-group-mail-1 ((,class (:weight bold :foreground "#FF50B0")))) `(gnus-group-mail-1-empty ((,class (:foreground "#5050B0")))) `(gnus-group-mail-2 ((,class (:weight bold :foreground "#FF0066")))) `(gnus-group-mail-2-empty ((,class (:foreground "#660066")))) - `(gnus-group-mail-3 ((,class (:weight bold :foreground "black")))) + `(gnus-group-mail-3 ((,class ,mail-unread))) `(gnus-group-mail-3-empty ((,class ,mail-read))) `(gnus-group-mail-low ((,class ,cancel))) `(gnus-group-mail-low-empty ((,class ,cancel))) @@ -173,8 +239,8 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(gnus-group-news-1-empty ((,class (:foreground "#5050B0")))) `(gnus-group-news-2 ((,class (:weight bold :foreground "#FF0066")))) `(gnus-group-news-2-empty ((,class (:foreground "#660066")))) - `(gnus-group-news-3 ((,class (:weight bold :foreground "black")))) - `(gnus-group-news-3-empty ((,class (:foreground "#808080")))) + `(gnus-group-news-3 ((,class ,mail-unread))) + `(gnus-group-news-3-empty ((,class ,mail-read))) `(gnus-group-news-4 ((,class (:weight bold :foreground "#FF0000")))) `(gnus-group-news-4-empty ((,class (:foreground "#990000")))) `(gnus-group-news-5 ((,class (:weight bold :foreground "#FF0099")))) @@ -194,11 +260,11 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(gnus-signature ((,class (:slant italic :foreground "#8B8D8E")))) `(gnus-splash ((,class (:foreground "#FF8C00")))) `(gnus-summary-cancelled ((,class ,cancel))) - `(gnus-summary-high-ancient ((,class (:weight normal :foreground "#808080" :background "#FFFFE6")))) - `(gnus-summary-high-read ((,class (:weight normal :foreground "#999999" :background "#FFFFE6")))) + `(gnus-summary-high-ancient ((,class ,mail-unread-high))) + `(gnus-summary-high-read ((,class ,mail-read-high))) `(gnus-summary-high-ticked ((,class ,mail-ticked))) - `(gnus-summary-high-unread ((,class (:weight bold :foreground "black" :background "#FFFFCC")))) - `(gnus-summary-low-ancient ((,class (:slant italic :foreground "gray55")))) + `(gnus-summary-high-unread ((,class ,mail-unread-high))) + `(gnus-summary-low-ancient ((,class (:slant italic :foreground "black")))) `(gnus-summary-low-read ((,class (:slant italic :foreground "#999999" :background "#E0E0E0")))) `(gnus-summary-low-ticked ((,class ,mail-ticked))) `(gnus-summary-low-unread ((,class (:slant italic :foreground "black")))) @@ -209,82 +275,105 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(gnus-summary-selected ((,class (:foreground "white" :background "#008CD7")))) `(gnus-x-face ((,class (:foreground "black" :background "white")))) - ;; Message faces + ;; Message faces. `(message-header-name ((,class ,mail-header-name))) `(message-header-cc ((,class ,mail-to))) `(message-header-other ((,class ,mail-header-other))) `(message-header-subject ((,class ,subject))) `(message-header-to ((,class ,mail-to))) - `(message-cited-text ((,class (:foreground "#5050B0")))) + `(message-cited-text ((,class (:foreground "#5050B0" :background "#F6F6F6")))) `(message-separator ((,class (:family "Sans Serif" :weight normal :foreground "#BDC2C6")))) `(message-header-newsgroups ((,class (:family "Sans Serif" :foreground "#3399CC")))) `(message-header-xheader ((,class ,mail-header-other))) `(message-mml ((,class (:foreground "forest green")))) - ;; Diff + ;; Diff. `(diff-added ((,class ,diff-added))) `(diff-changed ((,class ,diff-changed))) `(diff-context ((,class ,diff-none))) `(diff-file-header ((,class ,diff-header))) `(diff-file1-hunk-header ((,class (:foreground "dark magenta" :background "#EAF2F5")))) `(diff-file2-hunk-header ((,class (:foreground "#2B7E2A" :background "#EAF2F5")))) - `(diff-function ((,class (:foreground "darkgray")))) + `(diff-function ((,class (:foreground "#CC99CC")))) `(diff-header ((,class ,diff-header))) `(diff-hunk-header ((,class ,diff-hunk-header))) `(diff-index ((,class ,diff-header))) - `(diff-indicator-added ((,class (:background "#AAFFAA")))) - `(diff-indicator-changed ((,class (:background "#8080FF")))) - `(diff-indicator-removed ((,class (:background "#FFBBBB")))) + `(diff-indicator-added ((,class (:foreground "#3A993A" :background "#CDFFD8")))) + `(diff-indicator-changed ((,class (:background "#DBEDFF")))) + `(diff-indicator-removed ((,class (:foreground "#CC3333" :background "#FFDCE0")))) + `(diff-refine-added ((,class ,diff-refine-added))) `(diff-refine-change ((,class (:background "#DDDDFF")))) + `(diff-refine-removed ((,class ,diff-refine-removed))) `(diff-removed ((,class ,diff-removed))) - ;; SMerge + ;; SMerge. + `(smerge-mine ((,class ,diff-changed))) + `(smerge-other ((,class ,diff-added))) + `(smerge-base ((,class ,diff-removed))) + `(smerge-markers ((,class (:background "#FFE5CC")))) `(smerge-refined-change ((,class (:background "#AAAAFF")))) - ;; Ediff - `(ediff-current-diff-A ((,class (:foreground "gray33" :background "#FFDDDD")))) - `(ediff-current-diff-B ((,class (:foreground "gray33" :background "#DDFFDD")))) - `(ediff-current-diff-C ((,class (:foreground "black" :background "cyan")))) - `(ediff-even-diff-A ((,class (:foreground "black" :background "light grey")))) - `(ediff-even-diff-B ((,class (:foreground "black" :background "light grey")))) - `(ediff-fine-diff-A ((,class (:foreground "#A60000" :background "#FFAAAA")))) - `(ediff-fine-diff-B ((,class (:foreground "#008000" :background "#55FF55")))) - `(ediff-odd-diff-A ((,class (:foreground "black" :background "light grey")))) - `(ediff-odd-diff-B ((,class (:foreground "black" :background "light grey")))) - - ;; Flyspell -;; (when (version< emacs-version "24.XXX") - `(flyspell-duplicate ((,class (:underline "#008000" :inherit nil)))) - `(flyspell-incorrect ((,class (:underline "red" :inherit nil)))) -;; `(flyspell-duplicate ((,class (:underline (:style wave :color "#008000") :inherit nil)))) -;; `(flyspell-incorrect ((,class (:underline (:style wave :color "red") :inherit nil)))) - - ;; ;; Semantic faces + ;; Ediff. + `(ediff-current-diff-A ((,class (:background "#FFDDDD")))) + `(ediff-current-diff-B ((,class (:background "#DDFFDD")))) + `(ediff-current-diff-C ((,class (:background "cyan")))) + `(ediff-even-diff-A ((,class (:background "light grey")))) + `(ediff-even-diff-B ((,class (:background "light grey")))) + `(ediff-fine-diff-A ((,class (:background "#FFAAAA")))) + `(ediff-fine-diff-B ((,class (:background "#55FF55")))) + `(ediff-odd-diff-A ((,class (:background "light grey")))) + `(ediff-odd-diff-B ((,class (:background "light grey")))) + + ;; Flyspell. + (if (version< emacs-version "24.4") + `(flyspell-duplicate ((,class (:underline "#F4EB80" :inherit nil)))) + `(flyspell-duplicate ((,class (:underline (:style wave :color "#F4EB80") :background "#FAF7CC" :inherit nil))))) + (if (version< emacs-version "24.4") + `(flyspell-incorrect ((,class (:underline "#FAA7A5" :inherit nil)))) + `(flyspell-incorrect ((,class (:underline (:style wave :color "#FAA7A5") :background "#F4D7DA":inherit nil))))) + + ;; ;; Semantic faces. ;; `(semantic-decoration-on-includes ((,class (:underline ,cham-4)))) ;; `(semantic-decoration-on-private-members-face ((,class (:background ,alum-2)))) ;; `(semantic-decoration-on-protected-members-face ((,class (:background ,alum-2)))) - ;; `(semantic-decoration-on-unknown-includes ((,class (:background ,choc-3)))) + `(semantic-decoration-on-unknown-includes ((,class (:background "#FFF8F8")))) ;; `(semantic-decoration-on-unparsed-includes ((,class (:underline ,orange-3)))) - ;; `(semantic-tag-boundary-face ((,class (:overline ,blue-1)))) + `(semantic-highlight-func-current-tag-face ((,class ,highlight-current-tag))) + `(semantic-tag-boundary-face ((,class (:overline "#777777")))) ; Method separator. ;; `(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))) `(Info-title-1-face ((,class ,ol1))) `(Info-title-2-face ((,class ,ol2))) `(Info-title-3-face ((,class ,ol3))) `(Info-title-4-face ((,class ,ol4))) - `(ac-completion-face ((,class (:underline nil :foreground "#C0C0C0")))) ; like Google - `(ace-jump-face-foreground ((,class (:foreground "black" :background "#FBE448")))) + `(ace-jump-face-foreground ((,class (:weight bold :foreground "black" :background "#FEA500")))) + `(ahs-face ((,class (:background "#E4E4FF")))) + `(ahs-definition-face ((,class (:background "#FFB6C6")))) + `(ahs-plugin-defalt-face ((,class (:background "#FFE4FF")))) ; Current. + `(anzu-match-1 ((,class (:foreground "black" :background "aquamarine")))) + `(anzu-match-2 ((,class (:foreground "black" :background "springgreen")))) + `(anzu-match-3 ((,class (:foreground "black" :background "red")))) + `(anzu-mode-line ((,class (:foreground "black" :background "#80FF80")))) + `(anzu-mode-line-no-match ((,class (:foreground "black" :background "#FF8080")))) + `(anzu-replace-highlight ((,class (:inherit query-replace)))) + `(anzu-replace-to ((,class (:weight bold :foreground "#BD33FD" :background "#FDBD33")))) `(auto-dim-other-buffers-face ((,class (:background "#F7F7F7")))) + `(avy-background-face ((,class (:background "#A9A9A9")))) + `(avy-lead-face ((,class (:weight bold :foreground "black" :background "#FEA500")))) `(bbdb-company ((,class (:slant italic :foreground "steel blue")))) `(bbdb-field-name ((,class (:weight bold :foreground "steel blue")))) `(bbdb-field-value ((,class (:foreground "steel blue")))) `(bbdb-name ((,class (:underline t :foreground "#FF6633")))) - `(bmkp-light-autonamed ((,class (:background "#C2DDFD")))) - `(bmkp-light-fringe-autonamed ((,class (:background "#90AFD5")))) - `(bmkp-light-fringe-non-autonamed ((,class (:background "#D5FFD5")))) - `(bmkp-light-non-autonamed ((,class (:background "#C4FFC4")))) - `(browse-kill-ring-separator-face ((,class (:weight bold :foreground "slate gray")))) + `(bmkp-light-autonamed ((,class (:background "#F0F0F0")))) + `(bmkp-light-fringe-autonamed ((,class (:foreground "#5A5A5A" :background "#D4D4D4")))) + `(bmkp-light-fringe-non-autonamed ((,class (:foreground "#FFFFCC" :background "#01FFFB")))) ; default + `(bmkp-light-non-autonamed ((,class (:background "#BFFFFE")))) + `(bmkp-no-local ((,class (:background "pink")))) + `(browse-kill-ring-separator-face ((,class (:foreground "red")))) + `(calendar-month-header ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) `(calendar-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) + `(calendar-weekday-header ((,class (:weight bold :foreground "#1662AF")))) + `(calendar-weekend-header ((,class (:weight bold :foreground "#4E4E4E")))) `(cfw:face-annotation ((,class (:foreground "green" :background "red")))) `(cfw:face-day-title ((,class (:foreground "#C9C9C9")))) `(cfw:face-default-content ((,class (:foreground "#2952A3")))) @@ -299,12 +388,14 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(cfw:face-sunday ((,class (:foreground "#4E4E4E" :background "white" :weight bold)))) `(cfw:face-title ((,class (:height 2.0 :foreground "#676767" :weight bold :inherit variable-pitch)))) `(cfw:face-today ((,class (:foreground "#4F4A3D" :background "#FFFFCC")))) - `(cfw:face-today-title ((,class (:foreground "#4A95EB" :background "#FFFFCC")))) + `(cfw:face-today-title ((,class (:foreground "white" :background "#1766B1")))) `(cfw:face-toolbar ((,class (:background "white")))) `(cfw:face-toolbar-button-off ((,class (:foreground "#CFCFCF" :background "white")))) `(cfw:face-toolbar-button-on ((,class (:foreground "#5E5E5E" :background "#F6F6F6")))) - `(change-log-date-face ((,class (:foreground "purple")))) + `(change-log-date ((,class (:foreground "purple")))) `(change-log-file ((,class (:weight bold :foreground "#4183C4")))) + `(change-log-list ((,class (:foreground "black" :background "#75EEC7")))) + `(change-log-name ((,class (:foreground "#008000")))) `(circe-highlight-all-nicks-face ((,class (:foreground "blue" :background "#F0F0F0")))) ; other nick names `(circe-highlight-nick-face ((,class (:foreground "#009300" :background "#F0F0F0")))) ; messages with my nick cited `(circe-my-message-face ((,class (:foreground "#8B8B8B" :background "#F0F0F0")))) @@ -314,15 +405,38 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(comint-highlight-input ((,class (:weight bold :foreground "#0000FF" :inherit nil)))) ;; `(comint-highlight-prompt ((,class (:weight bold :foreground "black" :background "gold")))) `(comint-highlight-prompt ((,class (:weight bold :foreground "#0000FF" :inherit nil)))) - `(company-preview-common ((,class (:foreground "#C0C0C0" :background "#FFFFD7")))) ; same background as highlight-line - `(company-tooltip-annotation ((,class (:foreground "#999999" :background "cornsilk")))) - `(company-tooltip-common ((,class (:weight bold :inherit company-tooltip)))) - `(company-tooltip-common-selection ((,class (:weight bold :inherit company-tooltip-selection)))) + + ;; `(ac-selection-face ((,class ,completion-selected-candidate))) + `(ac-selection-face ((,class (:weight bold :foreground "white" :background "orange")))) ; TEMP For diff'ing AC from Comp. + `(ac-candidate-face ((,class ,completion-other-candidates))) + `(ac-completion-face ((,class ,completion-inline))) + `(ac-candidate-mouse-face ((,class (:inherit highlight)))) + `(popup-scroll-bar-background-face ((,class (:background "#EBF4FE")))) + `(popup-scroll-bar-foreground-face ((,class (:background "#D1DAE4")))) ; Scrollbar (visible). + + `(company-tooltip-common-selection ((,class (:weight normal :foreground "#F9ECCC" :inherit company-tooltip-selection)))) ; Prefix + common part in tooltip (for selection). + `(company-tooltip-selection ((,class ,completion-selected-candidate))) ; Suffix in tooltip (for selection). + `(company-tooltip-annotation-selection ((,class (:weight normal :foreground "#F9ECCC")))) ; Annotation (for selection). + + `(company-tooltip-common ((,class (:weight normal :foreground "#B000B0" :inherit company-tooltip)))) ; Prefix + common part in tooltip. + `(company-tooltip ((,class ,completion-other-candidates))) ; Suffix in tooltip. + `(company-tooltip-annotation ((,class (:weight normal :foreground "#2415FF")))) ; Annotation. + + `(company-preview-common ((,class ,completion-inline))) + + `(company-scrollbar-bg ((,class (:background "#EBF4FE")))) + `(company-scrollbar-fg ((,class (:background "#D1DAE4")))) ; Scrollbar (visible). + `(compare-windows ((,class (:background "#FFFF00")))) - `(compilation-error ((,class (:weight bold :foreground "red")))) - `(compilation-info ((,class (:weight bold :foreground "#2A489E")))) ; used for grep - `(compilation-line-number ((,class (:weight bold :foreground "#A535AE")))) + ;; `(completions-common-part ((,class (:foreground "red" :weight bold)))) + ;; `(completions-first-difference ((,class (:foreground "green" :weight bold)))) + `(compilation-error ((,class (:weight bold :foreground "red")))) ; Used for grep error messages. + `(compilation-info ((,class (:weight bold :foreground "#6784d7")))) + `(compilation-line-number ((,class ,grep-line-number))) `(compilation-warning ((,class (:weight bold :foreground "orange")))) + `(compilation-mode-line-exit ((,class (:weight bold :foreground "green")))) ; :exit[matched] + `(compilation-mode-line-fail ((,class (:weight bold :foreground "violet")))) ; :exit[no match] + `(compilation-mode-line-run ((,class (:weight bold :foreground "orange")))) ; :run `(css-property ((,class (:foreground "#00AA00")))) `(css-selector ((,class (:weight bold :foreground "blue")))) `(custom-button ((,class (:box (:line-width 2 :style released-button) :foreground "black" :background "lightgrey")))) @@ -348,11 +462,14 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(custom-variable-button ((,class (:weight bold :underline t)))) `(custom-variable-tag ((,class (:family "Sans Serif" :height 1.2 :weight bold :foreground "blue1")))) `(custom-visibility ((,class ,link))) - `(diff-hl-change ((,class (:foreground "blue3" :inherit diff-changed)))) - `(diff-hl-delete ((,class (:foreground "red3" :inherit diff-removed)))) - `(diff-hl-dired-change ((,class (:background "#FFA335" :foreground "black" :weight bold)))) + `(diff-hl-change ((,class (:foreground "blue3" :background "#DBEDFF")))) + `(diff-hl-delete ((,class (:foreground "red3" :background "#FFDCE0")))) + `(diff-hl-dired-change ((,class (:weight bold :foreground "black" :background "#FFA335")))) + `(diff-hl-dired-delete ((,class (:weight bold :foreground "#D73915")))) + `(diff-hl-dired-ignored ((,class (:weight bold :foreground "white" :background "#C0BBAB")))) + `(diff-hl-dired-insert ((,class (:weight bold :foreground "#B9B9BA")))) `(diff-hl-dired-unknown ((,class (:foreground "white" :background "#3F3BB4")))) - `(diff-hl-insert ((,class (:foreground "green4" :inherit diff-added)))) + `(diff-hl-insert ((,class (:foreground "green4" :background "#CDFFD8")))) `(diff-hl-unknown ((,class (:foreground "white" :background "#3F3BB4")))) `(diary-face ((,class (:foreground "#87C9FC")))) `(dircolors-face-asm ((,class (:foreground "black")))) @@ -385,17 +502,36 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(diredp-compressed-file-suffix ((,class (:foreground "red")))) `(diredp-date-time ((,class (:foreground "purple")))) `(diredp-dir-heading ((,class ,directory))) + `(diredp-dir-name ((,class ,directory))) `(diredp-dir-priv ((,class ,directory))) `(diredp-exec-priv ((,class (:background "#03C03C")))) `(diredp-executable-tag ((,class (:foreground "ForestGreen" :background "white")))) - `(diredp-file-name ((,class (:foreground "black")))) + `(diredp-file-name ((,class ,file))) `(diredp-file-suffix ((,class (:foreground "#C0C0C0")))) `(diredp-flag-mark-line ((,class ,marked-line))) `(diredp-ignored-file-name ((,class ,shadow))) `(diredp-read-priv ((,class (:background "#0A99FF")))) `(diredp-write-priv ((,class (:foreground "white" :background "#FF4040")))) + `(eldoc-highlight-function-argument ((,class (:weight bold :foreground "red" :background "#FFE4FF")))) + `(elfeed-search-filter-face ((,class (:foreground "gray")))) + ;; `(eww-form-checkbox ((,class ()))) + ;; `(eww-form-select ((,class ()))) + ;; `(eww-form-submit ((,class ()))) + `(eww-form-text ((,class (:weight bold :foreground "#40586F" :background "#A7CDF1")))) + ;; `(eww-form-textarea ((,class ()))) `(file-name-shadow ((,class ,shadow))) + `(flycheck-error ((,class (:underline (:color "#FE251E" :style wave) :weight bold :background "#FFE1E1")))) + `(flycheck-error-list-line-number ((,class (:foreground "#A535AE")))) + `(flycheck-fringe-error ((,class (:foreground "#FE251E")))) + `(flycheck-fringe-info ((,class (:foreground "#158A15")))) + `(flycheck-fringe-warning ((,class (:foreground "#F4A939")))) + `(flycheck-info ((,class (:underline (:color "#158A15" :style wave) :weight bold)))) + `(flycheck-warning ((,class (:underline (:color "#F4A939" :style wave) :weight bold :background "#FFFFBE")))) `(font-latex-bold-face ((,class (:weight bold :foreground "black")))) + `(fancy-narrow-blocked-face ((,class (:foreground "#9998A4")))) + `(flycheck-color-mode-line-error-face ((, class (:background "#CF5B56")))) + `(flycheck-color-mode-line-warning-face ((, class (:background "#EBC700")))) + `(flycheck-color-mode-line-info-face ((, class (:background "yellow")))) `(font-latex-italic-face ((,class (:slant italic :foreground "#1A1A1A")))) `(font-latex-math-face ((,class (:foreground "blue")))) `(font-latex-sectioning-1-face ((,class (:family "Sans Serif" :height 2.7 :weight bold :foreground "cornflower blue")))) @@ -408,36 +544,65 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(font-latex-verbatim-face ((,class (:foreground "#000088" :background "#FFFFE0" :inherit nil)))) `(git-commit-summary-face ((,class (:foreground "#000000")))) `(git-commit-comment-face ((,class (:slant italic :foreground "#696969")))) + `(git-timemachine-commit ((,class ,diff-removed))) + `(git-timemachine-minibuffer-author-face ((,class ,diff-added))) + `(git-timemachine-minibuffer-detail-face ((,class ,diff-header))) + `(google-translate-text-face ((,class (:foreground "#777777" :background "#F5F5F5")))) + `(google-translate-phonetic-face ((,class (:inherit shadow)))) + `(google-translate-translation-face ((,class (:weight normal :foreground "#3079ED" :background "#E3EAF2")))) + `(google-translate-suggestion-label-face ((,class (:foreground "red")))) + `(google-translate-suggestion-face ((,class (:slant italic :underline t)))) + `(google-translate-listen-button-face ((,class (:height 0.8)))) `(helm-action ((,class (:foreground "black")))) + `(helm-bookmark-file ((,class ,file))) `(helm-bookmarks-su-face ((,class (:foreground "red")))) + `(helm-buffer-directory ((,class ,directory))) + ;; `(helm-non-file-buffer ((,class (:slant italic :foreground "blue")))) + ;; `(helm-buffer-file ((,class (:foreground "#333333")))) + `(helm-buffer-modified ((,class (:slant italic :foreground "#BA36A5")))) `(helm-buffer-process ((,class (:foreground "#008200")))) `(helm-candidate-number ((,class (:foreground "black" :background "#FFFF66")))) `(helm-dir-heading ((,class (:foreground "blue" :background "pink")))) `(helm-dir-priv ((,class (:foreground "dark red" :background "light grey")))) `(helm-ff-directory ((,class ,directory))) + `(helm-ff-dotted-directory ((,class ,directory))) `(helm-ff-executable ((,class (:foreground "green3" :background "white")))) `(helm-ff-file ((,class (:foreground "black")))) `(helm-ff-invalid-symlink ((,class (:foreground "yellow" :background "red")))) `(helm-ff-symlink ((,class ,symlink))) `(helm-file-name ((,class (:foreground "blue")))) `(helm-gentoo-match-face ((,class (:foreground "red")))) + `(helm-grep-file ((,class ,grep-file-name))) + `(helm-grep-lineno ((,class ,grep-line-number))) `(helm-grep-match ((,class ,match))) `(helm-grep-running ((,class (:weight bold :foreground "white")))) - `(helm-grep-lineno ((,class ,shadow))) `(helm-isearch-match ((,class (:background "#CCFFCC")))) + `(helm-lisp-show-completion ((,class ,volatile-highlight-supersize))) ; See `helm-dabbrev'. + ;; `(helm-ls-git-added-copied-face ((,class (:foreground "")))) + ;; `(helm-ls-git-added-modified-face ((,class (:foreground "")))) + ;; `(helm-ls-git-conflict-face ((,class (:foreground "")))) + ;; `(helm-ls-git-deleted-and-staged-face ((,class (:foreground "")))) + ;; `(helm-ls-git-deleted-not-staged-face ((,class (:foreground "")))) + ;; `(helm-ls-git-modified-and-staged-face ((,class (:foreground "")))) + `(helm-ls-git-modified-not-staged-face ((,class (:foreground "#BA36A5")))) + ;; `(helm-ls-git-renamed-modified-face ((,class (:foreground "")))) + ;; `(helm-ls-git-untracked-face ((,class (:foreground "")))) `(helm-match ((,class ,match))) `(helm-moccur-buffer ((,class (:foreground "#0066CC")))) - `(helm-selection ((,class ,volatile-highlight))) - `(helm-selection-line ((,class ,volatile-highlight))) - `(helm-source-header ((,class (:family "Sans Serif" :height 1.3 :weight bold :foreground "white" :background "#2F69BF")))) - `(helm-swoop-target-line-face ((,class ,volatile-highlight))) + `(helm-selection ((,class (:background "#3875D6" :foreground "white")))) + `(helm-selection-line ((,class ,highlight-gray))) ; ??? + `(helm-separator ((,class (:foreground "red")))) + `(helm-source-header ((,class (:weight bold :box (:line-width 1 :color "#C7C7C7") :background "#DEDEDE" :foreground "black")))) `(helm-swoop-target-line-block-face ((,class (:background "#CCCC00" :foreground "#222222")))) + `(helm-swoop-target-line-face ((,class (:background "#CCCCFF")))) `(helm-swoop-target-word-face ((,class (:weight bold :foreground nil :background "#FDBD33")))) `(helm-visible-mark ((,class ,marked-line))) `(helm-w3m-bookmarks-face ((,class (:underline t :foreground "cyan1")))) + `(highlight-changes ((,class (:foreground nil)))) ;; blue "#2E08B5" + `(highlight-changes-delete ((,class (:strike-through nil :foreground nil)))) ;; red "#B5082E" `(highlight-symbol-face ((,class (:background "#FFFFA0")))) - `(hl-line ((,class ,highlight-line))) - `(hl-tags-face ((,class (:background "#FEFCAE")))) + `(hl-line ((,class ,highlight-yellow))) ; Highlight current line. + `(hl-tags-face ((,class ,highlight-current-tag))) ; ~ Pair highlighting (matching tags). `(holiday-face ((,class (:foreground "#777777" :background "#E4EBFE")))) `(html-helper-bold-face ((,class (:weight bold :foreground "black")))) `(html-helper-italic-face ((,class (:slant italic :foreground "black")))) @@ -448,9 +613,11 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(ilog-echo-face ((,class (:height 2.0 :foreground "#006FE0")))) `(ilog-load-face ((,class (:foreground "#BA36A5")))) `(ilog-message-face ((,class (:foreground "#808080")))) + `(indent-guide-face ((,class (:foreground "#D3D3D3")))) `(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box (:line-width 1 :color "#0000CC") :foreground "cornflower blue" :background "LightSteelBlue1")))) `(info-header-node ((,class (:underline t :foreground "orange")))) ; nodes in header `(info-header-xref ((,class (:underline t :foreground "dodger blue")))) ; cross references in header + `(info-index-match ((,class (:weight bold :foreground nil :background "#FDBD33")))) ; when using `i' `(info-menu-header ((,class ,ol2))) ; menu titles (headers) -- major topics `(info-menu-star ((,class (:foreground "black")))) ; every 3rd menu item `(info-node ((,class (:underline t :foreground "blue")))) ; node names @@ -459,16 +626,49 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(info-title-1 ((,class ,ol1))) `(info-xref ((,class (:underline t :foreground "#006DAF")))) ; unvisited cross-references `(info-xref-visited ((,class (:underline t :foreground "magenta4")))) ; previously visited cross-references + ;; js2-highlight-vars-face (~ auto-highlight-symbol) + `(js2-error ((,class (:box (:line-width 1 :color "#FF3737") :background "#FFC8C8")))) ; DONE. + `(js2-external-variable ((,class (:foreground "#FF0000" :background "#FFF8F8")))) ; DONE. + `(js2-function-param ((,class ,function-param))) + `(js2-instance-member ((,class (:foreground "DarkOrchid")))) + `(js2-jsdoc-html-tag-delimiter ((,class (:foreground "#D0372D")))) + `(js2-jsdoc-html-tag-name ((,class (:foreground "#D0372D")))) + `(js2-jsdoc-tag ((,class (:weight normal :foreground "#6434A3")))) + `(js2-jsdoc-type ((,class (:foreground "SteelBlue")))) + `(js2-jsdoc-value ((,class (:weight normal :foreground "#BA36A5")))) ; #800080 + `(js2-magic-paren ((,class (:underline t)))) + `(js2-private-function-call ((,class (:foreground "goldenrod")))) + `(js2-private-member ((,class (:foreground "PeachPuff3")))) + `(js2-warning ((,class (:underline "orange")))) + + ;; Org non-standard faces. + `(leuven-org-deadline-overdue ((,class (:foreground "#F22659")))) + `(leuven-org-deadline-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) + `(leuven-org-deadline-tomorrow ((,class (:foreground "#40A80B")))) + `(leuven-org-deadline-future ((,class (:foreground "#40A80B")))) + `(leuven-gnus-unseen ((,class (:weight bold :foreground "#FC7202")))) + `(leuven-gnus-date ((,class (:foreground "#FF80BF")))) + `(leuven-gnus-size ((,class (:foreground "#8FBF60")))) + `(leuven-todo-items-face ((,class (:weight bold :foreground "#FF3125" :background "#FFFF88")))) + `(light-symbol-face ((,class (:background "#FFFFA0")))) - `(linum ((,class (:inherit (default shadow) :foreground "#9A9A9A" :background "#EDEDED")))) + `(linum ((,class (:foreground "#9A9A9A" :background "#EDEDED")))) `(log-view-file ((,class (:foreground "#0000CC" :background "#EAF2F5")))) + `(log-view-message ((,class (:foreground "black" :background "#EDEA74")))) + `(lsp-ui-doc-background ((,class (:background "#F6FECD")))) `(lui-button-face ((,class ,link))) `(lui-highlight-face ((,class (:box '(:line-width 1 :color "#CC0000") :foreground "#CC0000" :background "#FFFF88")))) ; my nickname `(lui-time-stamp-face ((,class (:foreground "purple")))) + `(magit-blame-header ((,class (:inherit magit-diff-file-header)))) + `(magit-blame-heading ((,class (:overline "#A7A7A7" :foreground "red" :background "#E6E6E6")))) + `(magit-blame-hash ((,class (:overline "#A7A7A7" :foreground "red" :background "#E6E6E6")))) + `(magit-blame-name ((,class (:overline "#A7A7A7" :foreground "#036A07" :background "#E6E6E6")))) + `(magit-blame-date ((,class (:overline "#A7A7A7" :foreground "blue" :background "#E6E6E6")))) + `(magit-blame-summary ((,class (:overline "#A7A7A7" :weight bold :foreground "#707070" :background "#E6E6E6")))) `(magit-branch ((,class ,vc-branch))) `(magit-diff-add ((,class ,diff-added))) `(magit-diff-del ((,class ,diff-removed))) - `(magit-diff-file-header ((,class (:family "Sans Serif" :height 1.1 :weight bold :foreground "#4183C4")))) + `(magit-diff-file-header ((,class (:height 1.1 :weight bold :foreground "#4183C4")))) `(magit-diff-hunk-header ((,class ,diff-hunk-header))) `(magit-diff-none ((,class ,diff-none))) `(magit-header ((,class (:foreground "white" :background "#FF4040")))) @@ -476,48 +676,82 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(magit-item-mark ((,class ,marked-line))) `(magit-log-head-label ((,class (:box (:line-width 1 :color "blue" :style nil))))) `(magit-log-tag-label ((,class (:box (:line-width 1 :color "#00CC00" :style nil))))) + `(magit-section-highlight ((,class (:background "#F6FECD")))) `(magit-section-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "cornflower blue" :inherit nil)))) `(makefile-space-face ((,class (:background "hot pink")))) `(makefile-targets ((,class (:weight bold :foreground "blue")))) - `(match ((,class ,match))) + ;; `(markdown-blockquote-face ((,class ()))) + `(markdown-bold-face ((,class (:inherit bold)))) + ;; `(markdown-comment-face ((,class ()))) + ;; `(markdown-footnote-face ((,class ()))) + ;; `(markdown-header-delimiter-face ((,class ()))) + ;; `(markdown-header-face ((,class ()))) + `(markdown-header-face-1 ((,class ,ol1))) + `(markdown-header-face-2 ((,class ,ol2))) + `(markdown-header-face-3 ((,class ,ol3))) + `(markdown-header-face-4 ((,class ,ol4))) + `(markdown-header-face-5 ((,class ,ol5))) + `(markdown-header-face-6 ((,class ,ol6))) + ;; `(markdown-header-rule-face ((,class ()))) + `(markdown-inline-code-face ((,class ,code-inline))) + `(markdown-italic-face ((,class (:inherit italic)))) + `(markdown-language-keyword-face ((,class (:inherit org-block-begin-line)))) + ;; `(markdown-line-break-face ((,class ()))) + `(markdown-link-face ((,class ,link-no-underline))) + ;; `(markdown-link-title-face ((,class ()))) + ;; `(markdown-list-face ((,class ()))) + ;; `(markdown-math-face ((,class ()))) + ;; `(markdown-metadata-key-face ((,class ()))) + ;; `(markdown-metadata-value-face ((,class ()))) + ;; `(markdown-missing-link-face ((,class ()))) + `(markdown-pre-face ((,class (:inherit org-block-background)))) + ;; `(markdown-reference-face ((,class ()))) + ;; `(markdown-strike-through-face ((,class ()))) + `(markdown-url-face ((,class ,link))) + `(match ((,class ,match))) ; Used for grep matches. + `(mc/cursor-bar-face ((,class (:height 1.0 :foreground "#1664C4" :background "#1664C4")))) + `(mc/cursor-face ((,class (:inverse-video t)))) + `(mc/region-face ((,class (:inherit region)))) `(mm-uu-extract ((,class ,code-block))) `(moccur-current-line-face ((,class (:foreground "black" :background "#FFFFCC")))) `(moccur-face ((,class (:foreground "black" :background "#FFFF99")))) - `(next-error ((,class ,volatile-highlight))) + `(next-error ((,class ,volatile-highlight-supersize))) `(nobreak-space ((,class (:background "#CCE8F6")))) - `(nxml-attribute-local-name-face ((,class (:foreground "magenta")))) + `(nxml-attribute-local-name-face ((,class ,xml-attribute))) `(nxml-attribute-value-delimiter-face ((,class (:foreground "green4")))) `(nxml-attribute-value-face ((,class (:foreground "green4")))) `(nxml-comment-content-face ((,class (:slant italic :foreground "red")))) `(nxml-comment-delimiter-face ((,class (:foreground "red")))) - `(nxml-element-local-name ((,class (:box (:line-width 1 :color "#999999") :foreground "#000088" :background "#DEDEDE")))) + `(nxml-element-local-name ((,class ,xml-tag))) `(nxml-element-local-name-face ((,class (:foreground "blue")))) `(nxml-processing-instruction-target-face ((,class (:foreground "purple1")))) `(nxml-tag-delimiter-face ((,class (:foreground "blue")))) `(nxml-tag-slash-face ((,class (:foreground "blue")))) `(org-agenda-block-count ((,class (:weight bold :foreground "#A5A5A5")))) - `(org-agenda-calendar-event ((,class (:weight bold :foreground "#3774CC" :background "#A8C5EF")))) - `(org-agenda-calendar-sexp ((,class (:foreground "#777777" :background "#E4EBFE")))) + `(org-agenda-calendar-event ((,class (:weight bold :foreground "#3774CC" :background "#E4EBFE")))) + `(org-agenda-calendar-sexp ((,class (:foreground "#327ACD" :background "#F3F7FC")))) `(org-agenda-clocking ((,class (:foreground "black" :background "#EEC900")))) `(org-agenda-column-dateline ((,class ,column))) `(org-agenda-current-time ((,class (:underline t :foreground "#1662AF")))) - `(org-agenda-date ((,class (:height 1.6 :weight bold :foreground "#1662AF")))) - `(org-agenda-date-today ((,class (:height 1.6 :weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) - `(org-agenda-date-weekend ((,class (:height 1.6 :weight bold :foreground "#4E4E4E")))) + `(org-agenda-date ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#1662AF")))) + `(org-agenda-date-today ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) + `(org-agenda-date-weekend ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#4E4E4E")))) `(org-agenda-diary ((,class (:weight bold :foreground "green4" :background "light blue")))) `(org-agenda-dimmed-todo-face ((,class (:foreground "gold2")))) `(org-agenda-done ((,class (:foreground "#555555")))) `(org-agenda-filter-category ((,class (:weight bold :foreground "orange")))) + `(org-agenda-filter-effort ((,class (:weight bold :foreground "orange")))) + `(org-agenda-filter-regexp ((,class (:weight bold :foreground "orange")))) `(org-agenda-filter-tags ((,class (:weight bold :foreground "orange")))) `(org-agenda-restriction-lock ((,class (:background "#E77D63")))) - `(org-agenda-structure ((,class (:height 1.6 :weight bold :foreground "#1F8DD6")))) + `(org-agenda-structure ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#1F8DD6")))) `(org-archived ((,class (:foreground "gray70")))) `(org-beamer-tag ((,class (:box (:line-width 1 :color "#FABC18") :foreground "#2C2C2C" :background "#FFF8D0")))) `(org-block ((,class ,code-block))) - `(org-block-background ((,class (:background "#FFFFE0")))) + `(org-block-background ((,class (:background "#FFFFE0")))) ;; :inherit fixed-pitch)))) `(org-block-begin-line ((,class (:underline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) `(org-block-end-line ((,class (:overline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) - `(org-checkbox ((,class (:weight bold :box (:line-width 1 :style pressed-button) :foreground "white" :background "#777777")))) + `(org-checkbox ((,class (:weight bold :box (:line-width 1 :style pressed-button) :foreground "#123555" :background "#A3A3A3")))) `(org-clock-overlay ((,class (:foreground "white" :background "SkyBlue4")))) `(org-code ((,class ,code-inline))) `(org-column ((,class ,column))) @@ -527,14 +761,14 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(org-dim ((,class (:foreground "#AAAAAA")))) `(org-document-info ((,class (:foreground "#484848")))) `(org-document-info-keyword ((,class (:foreground "#008ED1" :background "#EAEAFF")))) - `(org-document-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "black")))) + `(org-document-title ((,class (:height 1.8 :weight bold :foreground "black")))) `(org-done ((,class (:weight bold :box (:line-width 1 :color "#BBBBBB") :foreground "#BBBBBB" :background "#F0F0F0")))) - `(org-drawer ((,class (:foreground "light sky blue")))) - `(org-ellipsis ((,class (:underline nil :box (:line-width 1 :color "#999999") :foreground "#999999" :background "#FFF8C0")))) ; #FFEE62 + `(org-drawer ((,class (:weight bold :foreground "#00BB00" :background "#EAFFEA" :extend nil)))) + `(org-ellipsis ((,class (:underline nil :foreground "#999999")))) ; #FFEE62 `(org-example ((,class (:foreground "blue" :background "#EAFFEA")))) `(org-footnote ((,class (:underline t :foreground "#008ED1")))) `(org-formula ((,class (:foreground "chocolate1")))) - `(org-headline-done ((,class (:height 1.0 :weight normal :strike-through t :foreground "#ADADAD")))) + `(org-headline-done ((,class (:height 1.0 :weight normal :foreground "#ADADAD")))) `(org-hide ((,class (:foreground "#E2E2E2")))) `(org-inlinetask ((,class (:box (:line-width 1 :color "#EBEBEB") :foreground "#777777" :background "#FFFFD6")))) `(org-latex-and-related ((,class (:foreground "#336699" :background "white")))) @@ -548,25 +782,25 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(org-level-8 ((,class ,ol8))) `(org-link ((,class ,link))) `(org-list-dt ((,class (:weight bold :foreground "#335EA8")))) - `(org-macro ((,class (:foreground "white" :background "#EDB802")))) + `(org-macro ((,class (:weight bold :foreground "#EDB802")))) `(org-meta-line ((,class (:slant normal :foreground "#008ED1" :background "#EAEAFF")))) - `(org-mode-line-clock ((,class ,clock-line))) + `(org-mode-line-clock ((,class (:box (:line-width 1 :color "#335EA8") :foreground "black" :background "#FFA335")))) `(org-mode-line-clock-overrun ((,class (:weight bold :box (:line-width 1 :color "#335EA8") :foreground "white" :background "#FF4040")))) `(org-number-of-items ((,class (:weight bold :foreground "white" :background "#79BA79")))) `(org-property-value ((,class (:foreground "#00A000")))) `(org-quote ((,class (:slant italic :foreground "dim gray" :background "#FFFFE0")))) `(org-scheduled ((,class (:foreground "#333333")))) - `(org-scheduled-previously ((,class (:foreground "#F22659")))) + `(org-scheduled-previously ((,class (:foreground "#1466C6")))) `(org-scheduled-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) `(org-sexp-date ((,class (:foreground "#3774CC")))) `(org-special-keyword ((,class (:weight bold :foreground "#00BB00" :background "#EAFFEA")))) - `(org-table ((,class (:foreground "dark green" :background "#EAFFEA")))) + `(org-table ((,class (:foreground "dark green" :background "#EAFFEA")))) ;; :inherit fixed-pitch)))) `(org-tag ((,class (:weight normal :slant italic :foreground "#9A9FA4" :background "white")))) - `(org-target ((,class ,link))) + `(org-target ((,class (:foreground "#FF6DAF")))) `(org-time-grid ((,class (:foreground "#CFCFCF")))) `(org-todo ((,class (:weight bold :box (:line-width 1 :color "#D8ABA7") :foreground "#D8ABA7" :background "#FFE6E4")))) `(org-upcoming-deadline ((,class (:foreground "#FF5555")))) - `(org-verbatim ((,class (:foreground "#0066CC")))) + `(org-verbatim ((,class (:foreground "#0066CC" :background "#F7FDFF")))) `(org-verse ((,class (:slant italic :foreground "dim gray" :background "#EEEEEE")))) `(org-warning ((,class (:weight bold :foreground "black" :background "#CCE7FF")))) `(outline-1 ((,class ,ol1))) @@ -577,17 +811,17 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(outline-6 ((,class ,ol6))) `(outline-7 ((,class ,ol7))) `(outline-8 ((,class ,ol8))) - `(pabbrev-debug-display-label-face ((,class (:background "chartreuse")))) + `(pabbrev-debug-display-label-face ((,class (:foreground "white" :background "#A62154")))) `(pabbrev-suggestions-face ((,class (:weight bold :foreground "white" :background "red")))) `(pabbrev-suggestions-label-face ((,class (:weight bold :foreground "white" :background "purple")))) `(paren-face-match ((,class ,paren-matched))) `(paren-face-mismatch ((,class ,paren-unmatched))) `(paren-face-no-match ((,class ,paren-unmatched))) `(persp-selected-face ((,class (:weight bold :foreground "#EEF5FE")))) - `(powerline-active1 ((,class (:background "grey22" :inherit mode-line)))) - `(powerline-active2 ((,class (:background "#4070B6" :inherit mode-line)))) - `(powerline-inactive1 ((,class (:background "#686868" :inherit mode-line-inactive)))) - `(powerline-inactive2 ((,class (:background "#A9A9A9" :inherit mode-line-inactive)))) + `(powerline-active1 ((,class (:foreground "#85CEEB" :background "#383838" :inherit mode-line)))) + `(powerline-active2 ((,class (:foreground "#85CEEB" :background "#4070B6" :inherit mode-line)))) + `(powerline-inactive1 ((,class (:foreground "#F0F0EF" :background "#686868" :inherit mode-line-inactive)))) + `(powerline-inactive2 ((,class (:foreground "#F0F0EF" :background "#A9A9A9" :inherit mode-line-inactive)))) `(rainbow-delimiters-depth-1-face ((,class (:foreground "#707183")))) `(rainbow-delimiters-depth-2-face ((,class (:foreground "#7388D6")))) `(rainbow-delimiters-depth-3-face ((,class (:foreground "#909183")))) @@ -599,29 +833,33 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(rainbow-delimiters-depth-9-face ((,class (:foreground "#887070")))) `(rainbow-delimiters-mismatched-face ((,class ,paren-unmatched))) `(rainbow-delimiters-unmatched-face ((,class ,paren-unmatched))) - `(realgud-overlay-arrow1 ((,class (:foreground "#005522")))) - `(realgud-overlay-arrow2 ((,class (:foreground "#c18401")))) - `(realgud-overlay-arrow3 ((,class (:foreground "#909183")))) - `(realgud-bp-disabled-face ((,class (:foreground "#909183")))) - `(realgud-bp-line-enabled-face ((,class (:underline "red")))) - `(realgud-bp-line-disabled-face ((,class (:underline "#909183")))) - `(realgud-file-name ((,class :foreground "#005522"))) - `(realgud-line-number ((,class :foreground "#A535AE"))) - `(realgud-backtrace-number ((,class :foreground "#A535AE" :weight bold))) `(recover-this-file ((,class (:weight bold :background "#FF3F3F")))) `(rng-error ((,class (:weight bold :foreground "red" :background "#FBE3E4")))) `(sh-heredoc ((,class (:foreground "blue" :background "#EEF5FE")))) `(sh-quoted-exec ((,class (:foreground "#FF1493")))) - `(shadow ((,class ,shadow))) + `(shadow ((,class ,shadow))) ; Used for grep context lines. `(shell-option-face ((,class (:foreground "forest green")))) `(shell-output-2-face ((,class (:foreground "blue")))) `(shell-output-3-face ((,class (:foreground "purple")))) `(shell-output-face ((,class (:foreground "black")))) ;; `(shell-prompt-face ((,class (:weight bold :foreground "yellow")))) + `(shm-current-face ((,class (:background "#EEE8D5")))) + `(shm-quarantine-face ((,class (:background "lemonchiffon")))) `(show-paren-match ((,class ,paren-matched))) `(show-paren-mismatch ((,class ,paren-unmatched))) `(sml-modeline-end-face ((,class (:background "#6BADF6")))) ; #335EA8 `(sml-modeline-vis-face ((,class (:background "#1979CA")))) + `(term ((,class (:foreground "#333333" :background "#FFFFFF")))) + + ;; `(sp-pair-overlay-face ((,class ()))) + ;; `(sp-show-pair-enclosing ((,class ()))) + ;; `(sp-show-pair-match-face ((,class ()))) ; ~ Pair highlighting (matching tags). + ;; `(sp-show-pair-mismatch-face ((,class ()))) + ;; `(sp-wrap-overlay-closing-pair ((,class ()))) + ;; `(sp-wrap-overlay-face ((,class ()))) + ;; `(sp-wrap-overlay-opening-pair ((,class ()))) + ;; `(sp-wrap-tag-overlay-face ((,class ()))) + `(speedbar-button-face ((,class (:foreground "green4")))) `(speedbar-directory-face ((,class (:foreground "blue4")))) `(speedbar-file-face ((,class (:foreground "cyan4")))) @@ -639,7 +877,6 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(tex-verbatim ((,class (:foreground "blue")))) `(tool-bar ((,class (:box (:line-width 1 :style released-button) :foreground "black" :background "gray75")))) `(tooltip ((,class (:foreground "black" :background "light yellow")))) - `(trailing-whitespace ((,class (:background "#F6EBFE")))) `(traverse-match-face ((,class (:weight bold :foreground "blue violet")))) `(vc-annotate-face-3F3FFF ((,class (:foreground "#3F3FFF" :background "black")))) `(vc-annotate-face-3F6CFF ((,class (:foreground "#3F3FFF" :background "black")))) @@ -654,11 +891,24 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(vc-annotate-face-83FF3F ((,class (:foreground "#B0FF3F" :background "black")))) `(vc-annotate-face-B0FF3F ((,class (:foreground "#B0FF3F" :background "black")))) `(vc-annotate-face-DDFF3F ((,class (:foreground "#FFF33F" :background "black")))) + `(vc-annotate-face-F6FFCC ((,class (:foreground "black" :background "#FFFFC0")))) `(vc-annotate-face-FF3F3F ((,class (:foreground "#FF3F3F" :background "black")))) `(vc-annotate-face-FF6C3F ((,class (:foreground "#FF3F3F" :background "black")))) `(vc-annotate-face-FF993F ((,class (:foreground "#FF993F" :background "black")))) `(vc-annotate-face-FFC63F ((,class (:foreground "#FF993F" :background "black")))) `(vc-annotate-face-FFF33F ((,class (:foreground "#FFF33F" :background "black")))) + + ;; ;; vc + ;; (vc-up-to-date-state ((,c :foreground ,(gc 'green-1)))) + ;; (vc-edited-state ((,c :foreground ,(gc 'yellow+1)))) + ;; (vc-missing-state ((,c :foreground ,(gc 'red)))) + ;; (vc-conflict-state ((,c :foreground ,(gc 'red+2) :weight bold))) + ;; (vc-locked-state ((,c :foreground ,(gc 'cyan-1)))) + ;; (vc-locally-added-state ((,c :foreground ,(gc 'blue)))) + ;; (vc-needs-update-state ((,c :foreground ,(gc 'magenta)))) + ;; (vc-removed-state ((,c :foreground ,(gc 'red-1)))) + + `(vhl/default-face ((,class ,volatile-highlight))) ; `volatile-highlights.el' (for undo, yank). `(w3m-anchor ((,class ,link))) `(w3m-arrived-anchor ((,class (:foreground "purple1")))) `(w3m-bitmap-image-face ((,class (:foreground "gray4" :background "green")))) @@ -675,38 +925,138 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(w3m-link-numbering ((,class (:foreground "#B4C7EB")))) ; mouseless browsing `(w3m-strike-through-face ((,class (:strike-through t)))) `(w3m-underline-face ((,class (:underline t)))) - `(which-func ((,class (:weight bold :foreground "white")))) + + ;; `(web-mode-block-attr-name-face ((,class ()))) + ;; `(web-mode-block-attr-value-face ((,class ()))) + ;; `(web-mode-block-comment-face ((,class ()))) + ;; `(web-mode-block-control-face ((,class ()))) + ;; `(web-mode-block-delimiter-face ((,class ()))) + ;; `(web-mode-block-face ((,class ()))) + ;; `(web-mode-block-string-face ((,class ()))) + ;; `(web-mode-bold-face ((,class ()))) + ;; `(web-mode-builtin-face ((,class ()))) + ;; `(web-mode-comment-face ((,class ()))) + ;; `(web-mode-comment-keyword-face ((,class ()))) + ;; `(web-mode-constant-face ((,class ()))) + ;; `(web-mode-css-at-rule-face ((,class ()))) + ;; `(web-mode-css-color-face ((,class ()))) + ;; `(web-mode-css-comment-face ((,class ()))) + ;; `(web-mode-css-function-face ((,class ()))) + ;; `(web-mode-css-priority-face ((,class ()))) + ;; `(web-mode-css-property-name-face ((,class ()))) + ;; `(web-mode-css-pseudo-class-face ((,class ()))) + ;; `(web-mode-css-selector-face ((,class ()))) + ;; `(web-mode-css-string-face ((,class ()))) + ;; `(web-mode-css-variable-face ((,class ()))) + ;; `(web-mode-current-column-highlight-face ((,class ()))) + `(web-mode-current-element-highlight-face ((,class (:background "#99CCFF")))) ; #FFEE80 + ;; `(web-mode-doctype-face ((,class ()))) + ;; `(web-mode-error-face ((,class ()))) + ;; `(web-mode-filter-face ((,class ()))) + `(web-mode-folded-face ((,class (:box (:line-width 1 :color "#777777") :foreground "#9A9A6A" :background "#F3F349")))) + ;; `(web-mode-function-call-face ((,class ()))) + ;; `(web-mode-function-name-face ((,class ()))) + ;; `(web-mode-html-attr-custom-face ((,class ()))) + ;; `(web-mode-html-attr-engine-face ((,class ()))) + ;; `(web-mode-html-attr-equal-face ((,class ()))) + `(web-mode-html-attr-name-face ((,class ,xml-attribute))) + ;; `(web-mode-html-attr-value-face ((,class ()))) + ;; `(web-mode-html-entity-face ((,class ()))) + `(web-mode-html-tag-bracket-face ((,class ,xml-tag))) + ;; `(web-mode-html-tag-custom-face ((,class ()))) + `(web-mode-html-tag-face ((,class ,xml-tag))) + ;; `(web-mode-html-tag-namespaced-face ((,class ()))) + ;; `(web-mode-inlay-face ((,class ()))) + ;; `(web-mode-italic-face ((,class ()))) + ;; `(web-mode-javascript-comment-face ((,class ()))) + ;; `(web-mode-javascript-string-face ((,class ()))) + ;; `(web-mode-json-comment-face ((,class ()))) + ;; `(web-mode-json-context-face ((,class ()))) + ;; `(web-mode-json-key-face ((,class ()))) + ;; `(web-mode-json-string-face ((,class ()))) + ;; `(web-mode-jsx-depth-1-face ((,class ()))) + ;; `(web-mode-jsx-depth-2-face ((,class ()))) + ;; `(web-mode-jsx-depth-3-face ((,class ()))) + ;; `(web-mode-jsx-depth-4-face ((,class ()))) + ;; `(web-mode-keyword-face ((,class ()))) + ;; `(web-mode-param-name-face ((,class ()))) + ;; `(web-mode-part-comment-face ((,class ()))) + `(web-mode-part-face ((,class (:background "#FFFFE0")))) + ;; `(web-mode-part-string-face ((,class ()))) + ;; `(web-mode-preprocessor-face ((,class ()))) + `(web-mode-script-face ((,class (:background "#EFF0F1")))) + ;; `(web-mode-sql-keyword-face ((,class ()))) + ;; `(web-mode-string-face ((,class ()))) + ;; `(web-mode-style-face ((,class ()))) + ;; `(web-mode-symbol-face ((,class ()))) + ;; `(web-mode-type-face ((,class ()))) + ;; `(web-mode-underline-face ((,class ()))) + ;; `(web-mode-variable-name-face ((,class ()))) + ;; `(web-mode-warning-face ((,class ()))) + ;; `(web-mode-whitespace-face ((,class ()))) + + `(which-func ((,class (:weight bold :slant italic :foreground "white")))) + ;; `(which-key-command-description-face) + ;; `(which-key-group-description-face) + ;; `(which-key-highlighted-command-face) + ;; `(which-key-key-face) + `(which-key-local-map-description-face ((,class (:weight bold :background "#F3F7FC" :inherit which-key-command-description-face)))) + ;; `(which-key-note-face) + ;; `(which-key-separator-face) + ;; `(which-key-special-key-face) `(widget-button ((,class ,link))) `(widget-button-pressed ((,class (:foreground "red")))) `(widget-documentation ((,class (:foreground "green4")))) `(widget-field ((,class (:background "gray85")))) `(widget-inactive ((,class (:foreground "dim gray")))) `(widget-single-line-field ((,class (:background "gray85")))) - `(yas/field-debug-face ((,class (:background "ivory2")))) - `(yas/field-highlight-face ((,class (:background "DarkSeaGreen1")))) + `(woman-bold ((,class (:weight bold :foreground "#F13D3D")))) + `(woman-italic ((,class (:weight bold :slant italic :foreground "#46BE1B")))) + `(woman-symbol ((,class (:weight bold :foreground "purple")))) + `(yas-field-debug-face ((,class (:foreground "white" :background "#A62154")))) + `(yas-field-highlight-face ((,class (:box (:line-width 1 :color "#838383") :foreground "black" :background "#D4DCD8")))) + + ;; `(ztreep-arrow-face ((,class ()))) + ;; `(ztreep-diff-header-face ((,class ()))) + ;; `(ztreep-diff-header-small-face ((,class ()))) + `(ztreep-diff-model-add-face ((,class (:weight bold :foreground "#008800")))) + `(ztreep-diff-model-diff-face ((,class (:weight bold :foreground "#0044DD")))) + `(ztreep-diff-model-ignored-face ((,class (:strike-through t :foreground "#9E9E9E")))) + `(ztreep-diff-model-normal-face ((,class (:foreground "#000000")))) + ;; `(ztreep-expand-sign-face ((,class ()))) + ;; `(ztreep-header-face ((,class ()))) + ;; `(ztreep-leaf-face ((,class ()))) + ;; `(ztreep-node-face ((,class ()))) + )) (custom-theme-set-variables 'leuven - '(ansi-color-faces-vector - [default default default italic underline success warning error]) - '(ansi-color-names-vector - ["black" "red3" "ForestGreen" "yellow3" "blue" "magenta3" "DeepSkyBlue" "gray50"]) - ; colors used in Shell mode + + ;; highlight-sexp-mode. + '(hl-sexp-background-color "#efebe9") + + '(ansi-color-faces-vector + [default default default italic underline success warning error]) + + ;; Colors used in Shell mode. + '(ansi-color-names-vector + ["black" "red3" "ForestGreen" "yellow3" "blue" "magenta3" "DeepSkyBlue" "gray50"]) ) ;;;###autoload (when (and (boundp 'custom-theme-load-path) load-file-name) - ;; add theme folder to `custom-theme-load-path' when installing over MELPA + ;; Add theme folder to `custom-theme-load-path' when installing over MELPA. (add-to-list 'custom-theme-load-path (file-name-as-directory (file-name-directory load-file-name)))) (provide-theme 'leuven) +;; This is for the sake of Emacs. ;; Local Variables: +;; time-stamp-end: "$" ;; time-stamp-format: "%:y%02m%02d.%02H%02M" ;; time-stamp-start: "Version: " -;; time-stamp-end: "$" ;; End: ;;; leuven-theme.el ends here diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL index eb3acde9c01..227c13f3e3a 100644 --- a/etc/tutorials/TUTORIAL +++ b/etc/tutorials/TUTORIAL @@ -612,11 +612,11 @@ but it also means that you need a convenient way to save the first file's buffer. Having to switch back to that buffer, in order to save it with C-x C-s, would be a nuisance. So we have - C-x s Save some buffers + C-x s Save some buffers to their files -C-x s asks you about each buffer which contains changes that you have -not saved. It asks you, for each such buffer, whether to save the -buffer. +C-x s asks you about each file-visiting buffer which contains changes +that you have not saved. It asks you, for each such buffer, whether +to save the buffer to its file. >> Insert a line of text, then type C-x s. It should ask you whether to save the buffer named TUTORIAL. @@ -660,8 +660,8 @@ as by a mail handling utility. There are many C-x commands. Here is a list of the ones you have learned: C-x C-f Find file - C-x C-s Save file - C-x s Save some buffers + C-x C-s Save buffer to file + C-x s Save some buffers to their files C-x C-b List buffers C-x b Switch buffer C-x C-c Quit Emacs @@ -1081,7 +1081,7 @@ corresponding command names (such as C-x C-f beside find-file). You can learn more about Emacs by reading its manual, either as a printed book, or inside Emacs (use the Help menu or type C-h r). Two features that you may like especially are completion, which saves -typing, and dired, which simplifies file handling. +typing, and Dired, which simplifies file handling. Completion is a way to avoid unnecessary typing. For instance, if you want to switch to the *Messages* buffer, you can type C-x b *M<Tab> diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 380be95222b..871fa7a8d3c 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1504,11 +1504,17 @@ set_local_socket (char const *server_name) "%s: (Be careful: XDG_RUNTIME_DIR is security-related.)\n"), progname, sockdirname, progname); } - message (true, - ("%s: can't find socket; have you started the server?\n" - "%s: To start the server in Emacs," - " type \"M-x server-start\".\n"), - progname, progname); + + /* If there's an alternate editor and the user has requested + --quiet, don't output the warning. */ + if (!quiet || !alternate_editor) + { + message (true, + ("%s: can't find socket; have you started the server?\n" + "%s: To start the server in Emacs," + " type \"M-x server-start\".\n"), + progname, progname); + } } else message (true, "%s: can't stat %s: %s\n", diff --git a/lib/alloca.in.h b/lib/alloca.in.h index 5686b082bbe..c71e9bfed9e 100644 --- a/lib/alloca.in.h +++ b/lib/alloca.in.h @@ -44,7 +44,7 @@ # endif #endif #ifndef alloca -# ifdef __GNUC__ +# if defined __GNUC__ || (__clang_major__ >= 4) # define alloca __builtin_alloca # elif defined _AIX # define alloca __alloca diff --git a/lib/arg-nonnull.h b/lib/arg-nonnull.h index ac26ca8cfed..db9d9ae116a 100644 --- a/lib/arg-nonnull.h +++ b/lib/arg-nonnull.h @@ -18,7 +18,7 @@ that the values passed as arguments n, ..., m must be non-NULL pointers. n = 1 stands for the first argument, n = 2 for the second argument etc. */ #ifndef _GL_ARG_NONNULL -# if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || __GNUC__ > 3 +# if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || defined __clang__ # define _GL_ARG_NONNULL(params) __attribute__ ((__nonnull__ params)) # else # define _GL_ARG_NONNULL(params) diff --git a/lib/binary-io.h b/lib/binary-io.h index 477b4bf4dd3..d17af7c3807 100644 --- a/lib/binary-io.h +++ b/lib/binary-io.h @@ -56,7 +56,7 @@ __gl_setmode (int fd _GL_UNUSED, int mode _GL_UNUSED) /* Set FD's mode to MODE, which should be either O_TEXT or O_BINARY. Return the old mode if successful, -1 (setting errno) on failure. Ordinarily this function would be called 'setmode', since that is - its name on MS-Windows, but it is called 'set_binary_mode' here + its old name on MS-Windows, but it is called 'set_binary_mode' here to avoid colliding with a BSD function of another name. */ #if defined __DJGPP__ || defined __EMX__ diff --git a/lib/c++defs.h b/lib/c++defs.h index 3e6aaabc9ce..6a9bf295eb5 100644 --- a/lib/c++defs.h +++ b/lib/c++defs.h @@ -146,6 +146,16 @@ _GL_EXTERN_C int _gl_cxxalias_dummy #endif +/* _GL_CXXALIAS_MDA (func, rettype, parameters); + is to be used when func is a Microsoft deprecated alias, on native Windows. + It declares a C++ alias called GNULIB_NAMESPACE::func + that redirects to _func, if GNULIB_NAMESPACE is defined. + Example: + _GL_CXXALIAS_MDA (open, int, (const char *filename, int flags, ...)); + */ +#define _GL_CXXALIAS_MDA(func,rettype,parameters) \ + _GL_CXXALIAS_RPL_1 (func, _##func, rettype, parameters) + /* _GL_CXXALIAS_RPL_CAST_1 (func, rpl_func, rettype, parameters); is like _GL_CXXALIAS_RPL_1 (func, rpl_func, rettype, parameters); except that the C function rpl_func may have a slightly different @@ -268,7 +278,7 @@ _GL_CXXALIASWARN_2 (func, namespace) /* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>, we enable the warning only when not optimizing. */ -# if !__OPTIMIZE__ +# if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__) # define _GL_CXXALIASWARN_2(func,namespace) \ _GL_WARN_ON_USE (func, \ "The symbol ::" #func " refers to the system function. " \ @@ -296,9 +306,9 @@ _GL_CXXALIASWARN1_2 (func, rettype, parameters_and_attributes, namespace) /* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>, we enable the warning only when not optimizing. */ -# if !__OPTIMIZE__ +# if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__) # define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \ - _GL_WARN_ON_USE_CXX (func, rettype, parameters_and_attributes, \ + _GL_WARN_ON_USE_CXX (func, rettype, rettype, parameters_and_attributes, \ "The symbol ::" #func " refers to the system function. " \ "Use " #namespace "::" #func " instead.") # else diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c index 9f990988393..0b89d2a1842 100644 --- a/lib/canonicalize-lgpl.c +++ b/lib/canonicalize-lgpl.c @@ -52,7 +52,9 @@ # include "pathmax.h" # include "malloca.h" # include "filename.h" -# if HAVE_GETCWD +# if defined _WIN32 && !defined __CYGWIN__ +# define __getcwd _getcwd +# elif HAVE_GETCWD # if IN_RELOCWRAPPER /* When building the relocatable program wrapper, use the system's getcwd function, not the gnulib override, otherwise we would get a link error. diff --git a/lib/cdefs.h b/lib/cdefs.h index d8e4a000333..b1870fd0a93 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -34,7 +34,34 @@ #undef __P #undef __PMT -#ifdef __GNUC__ +/* Compilers that are not clang may object to + #if defined __clang__ && __has_attribute(...) + even though they do not need to evaluate the right-hand side of the &&. */ +#if defined __clang__ && defined __has_attribute +# define __glibc_clang_has_attribute(name) __has_attribute (name) +#else +# define __glibc_clang_has_attribute(name) 0 +#endif + +/* Compilers that are not clang may object to + #if defined __clang__ && __has_builtin(...) + even though they do not need to evaluate the right-hand side of the &&. */ +#if defined __clang__ && defined __has_builtin +# define __glibc_clang_has_builtin(name) __has_builtin (name) +#else +# define __glibc_clang_has_builtin(name) 0 +#endif + +/* Compilers that are not clang may object to + #if defined __clang__ && __has_extension(...) + even though they do not need to evaluate the right-hand side of the &&. */ +#if defined __clang__ && defined __has_extension +# define __glibc_clang_has_extension(ext) __has_extension (ext) +#else +# define __glibc_clang_has_extension(ext) 0 +#endif + +#if defined __GNUC__ || defined __clang__ /* All functions, except those with callbacks or those that synchronize memory, are leaf functions. */ @@ -51,13 +78,14 @@ gcc 2.8.x and egcs. For gcc 3.2 and up we even mark C functions as non-throwing using a function attribute since programs can use the -fexceptions options for C code as well. */ -# if !defined __cplusplus && __GNUC_PREREQ (3, 3) +# if !defined __cplusplus \ + && (__GNUC_PREREQ (3, 3) || __glibc_clang_has_attribute (__nothrow__)) # define __THROW __attribute__ ((__nothrow__ __LEAF)) # define __THROWNL __attribute__ ((__nothrow__)) # define __NTH(fct) __attribute__ ((__nothrow__ __LEAF)) fct # define __NTHNL(fct) __attribute__ ((__nothrow__)) fct # else -# if defined __cplusplus && __GNUC_PREREQ (2,8) +# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major >= 4) # define __THROW throw () # define __THROWNL throw () # define __NTH(fct) __LEAF_ATTR fct throw () @@ -70,7 +98,7 @@ # endif # endif -#else /* Not GCC. */ +#else /* Not GCC or clang. */ # if (defined __cplusplus \ || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L)) @@ -83,16 +111,7 @@ # define __THROWNL # define __NTH(fct) fct -#endif /* GCC. */ - -/* Compilers that are not clang may object to - #if defined __clang__ && __has_extension(...) - even though they do not need to evaluate the right-hand side of the &&. */ -#if defined __clang__ && defined __has_extension -# define __glibc_clang_has_extension(ext) __has_extension (ext) -#else -# define __glibc_clang_has_extension(ext) 0 -#endif +#endif /* GCC || clang. */ /* These two macros are not used in glibc anymore. They are kept here only because some other projects expect the macros to be defined. */ @@ -129,6 +148,12 @@ # define __warnattr(msg) __attribute__((__warning__ (msg))) # define __errordecl(name, msg) \ extern void name (void) __attribute__((__error__ (msg))) +#elif __glibc_clang_has_attribute (__diagnose_if__) && 0 /* fails on Fedora 31 with Clang 9. */ +# define __warndecl(name, msg) \ + extern void name (void) __attribute__((__diagnose_if__ (1, msg, "warning"))) +# define __warnattr(msg) __attribute__((__diagnose_if__ (1, msg, "warning"))) +# define __errordecl(name, msg) \ + extern void name (void) __attribute__((__diagnose_if__ (1, msg, "error"))) #else # define __warndecl(name, msg) extern void name (void) # define __warnattr(msg) @@ -142,8 +167,8 @@ #if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L && !defined __HP_cc # define __flexarr [] # define __glibc_c99_flexarr_available 1 -#elif __GNUC_PREREQ (2,97) -/* GCC 2.97 supports C99 flexible array members as an extension, +#elif __GNUC_PREREQ (2,97) || defined __clang__ +/* GCC 2.97 and clang support C99 flexible array members as an extension, even when in C89 mode or compiling C++ (any version). */ # define __flexarr [] # define __glibc_c99_flexarr_available 1 @@ -169,7 +194,7 @@ Example: int __REDIRECT(setpgrp, (__pid_t pid, __pid_t pgrp), setpgid); */ -#if defined __GNUC__ && __GNUC__ >= 2 +#if (defined __GNUC__ && __GNUC__ >= 2) || (__clang_major__ >= 4) # define __REDIRECT(name, proto, alias) name proto __asm__ (__ASMNAME (#alias)) # ifdef __cplusplus @@ -194,17 +219,17 @@ */ #endif -/* GCC has various useful declarations that can be made with the - `__attribute__' syntax. All of the ways we use this do fine if - they are omitted for compilers that don't understand it. */ -#if !defined __GNUC__ || __GNUC__ < 2 +/* GCC and clang have various useful declarations that can be made with + the '__attribute__' syntax. All of the ways we use this do fine if + they are omitted for compilers that don't understand it. */ +#if !(defined __GNUC__ || defined __clang__) # define __attribute__(xyz) /* Ignore */ #endif /* At some point during the gcc 2.96 development the `malloc' attribute for functions was introduced. We don't want to use it unconditionally (although this would be possible) since it generates warnings. */ -#if __GNUC_PREREQ (2,96) +#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__malloc__) # define __attribute_malloc__ __attribute__ ((__malloc__)) #else # define __attribute_malloc__ /* Ignore */ @@ -222,14 +247,14 @@ /* At some point during the gcc 2.96 development the `pure' attribute for functions was introduced. We don't want to use it unconditionally (although this would be possible) since it generates warnings. */ -#if __GNUC_PREREQ (2,96) +#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__pure__) # define __attribute_pure__ __attribute__ ((__pure__)) #else # define __attribute_pure__ /* Ignore */ #endif /* This declaration tells the compiler that the value is constant. */ -#if __GNUC_PREREQ (2,5) +#if __GNUC_PREREQ (2,5) || __glibc_clang_has_attribute (__const__) # define __attribute_const__ __attribute__ ((__const__)) #else # define __attribute_const__ /* Ignore */ @@ -238,7 +263,7 @@ /* At some point during the gcc 3.1 development the `used' attribute for functions was introduced. We don't want to use it unconditionally (although this would be possible) since it generates warnings. */ -#if __GNUC_PREREQ (3,1) +#if __GNUC_PREREQ (3,1) || __glibc_clang_has_attribute (__used__) # define __attribute_used__ __attribute__ ((__used__)) # define __attribute_noinline__ __attribute__ ((__noinline__)) #else @@ -247,7 +272,7 @@ #endif /* Since version 3.2, gcc allows marking deprecated functions. */ -#if __GNUC_PREREQ (3,2) +#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__deprecated__) # define __attribute_deprecated__ __attribute__ ((__deprecated__)) #else # define __attribute_deprecated__ /* Ignore */ @@ -270,7 +295,7 @@ If several `format_arg' attributes are given for the same function, in gcc-3.0 and older, all but the last one are ignored. In newer gccs, all designated arguments are considered. */ -#if __GNUC_PREREQ (2,8) +#if __GNUC_PREREQ (2,8) || __glibc_clang_has_attribute (__format_arg__) # define __attribute_format_arg__(x) __attribute__ ((__format_arg__ (x))) #else # define __attribute_format_arg__(x) /* Ignore */ @@ -280,7 +305,7 @@ attribute for functions was introduced. We don't want to use it unconditionally (although this would be possible) since it generates warnings. */ -#if __GNUC_PREREQ (2,97) +#if __GNUC_PREREQ (2,97) || __glibc_clang_has_attribute (__format__) # define __attribute_format_strfmon__(a,b) \ __attribute__ ((__format__ (__strfmon__, a, b))) #else @@ -291,7 +316,7 @@ must not be NULL. Do not define __nonnull if it is already defined, for portability when this file is used in Gnulib. */ #ifndef __nonnull -# if __GNUC_PREREQ (3,3) +# if __GNUC_PREREQ (3,3) || __glibc_clang_has_attribute (__nonnull__) # define __nonnull(params) __attribute__ ((__nonnull__ params)) # else # define __nonnull(params) @@ -300,7 +325,7 @@ /* If fortification mode, we warn about unused results of certain function calls which can lead to problems. */ -#if __GNUC_PREREQ (3,4) +#if __GNUC_PREREQ (3,4) || __glibc_clang_has_attribute (__warn_unused_result__) # define __attribute_warn_unused_result__ \ __attribute__ ((__warn_unused_result__)) # if defined __USE_FORTIFY_LEVEL && __USE_FORTIFY_LEVEL > 0 @@ -314,7 +339,7 @@ #endif /* Forces a function to be always inlined. */ -#if __GNUC_PREREQ (3,2) +#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__always_inline__) /* The Linux kernel defines __always_inline in stddef.h (283d7573), and it conflicts with this definition. Therefore undefine it first to allow either header to be included first. */ @@ -327,7 +352,7 @@ /* Associate error messages with the source location of the call site rather than with the source location inside the function. */ -#if __GNUC_PREREQ (4,3) +#if __GNUC_PREREQ (4,3) || __glibc_clang_has_attribute (__artificial__) # define __attribute_artificial__ __attribute__ ((__artificial__)) #else # define __attribute_artificial__ /* Ignore */ @@ -370,12 +395,14 @@ run in pedantic mode if the uses are carefully marked using the `__extension__' keyword. But this is not generally available before version 2.8. */ -#if !__GNUC_PREREQ (2,8) +#if !(__GNUC_PREREQ (2,8) || defined __clang__) # define __extension__ /* Ignore */ #endif -/* __restrict is known in EGCS 1.2 and above. */ -#if !__GNUC_PREREQ (2,92) +/* __restrict is known in EGCS 1.2 and above, and in clang. + It works also in C++ mode (outside of arrays), but only when spelled + as '__restrict', not 'restrict'. */ +#if !(__GNUC_PREREQ (2,92) || __clang_major__ >= 3) # if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L # define __restrict restrict # else @@ -385,8 +412,9 @@ /* ISO C99 also allows to declare arrays as non-overlapping. The syntax is array_name[restrict] - GCC 3.1 supports this. */ -#if __GNUC_PREREQ (3,1) && !defined __GNUG__ + GCC 3.1 and clang support this. + This syntax is not usable in C++ mode. */ +#if (__GNUC_PREREQ (3,1) || __clang_major__ >= 3) && !defined __cplusplus # define __restrict_arr __restrict #else # ifdef __GNUC__ @@ -401,7 +429,7 @@ # endif #endif -#if __GNUC__ >= 3 +#if (__GNUC__ >= 3) || __glibc_clang_has_builtin (__builtin_expect) # define __glibc_unlikely(cond) __builtin_expect ((cond), 0) # define __glibc_likely(cond) __builtin_expect ((cond), 1) #else @@ -417,7 +445,8 @@ #if (!defined _Noreturn \ && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \ - && !__GNUC_PREREQ (4,7)) + && !(__GNUC_PREREQ (4,7) \ + || (3 < __clang_major__ + (5 <= __clang_minor__)))) # if __GNUC_PREREQ (2,8) # define _Noreturn __attribute__ ((__noreturn__)) # else @@ -436,7 +465,8 @@ #if (!defined _Static_assert && !defined __cplusplus \ && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \ - && (!__GNUC_PREREQ (4, 6) || defined __STRICT_ANSI__)) + && (!(__GNUC_PREREQ (4, 6) || __clang_major__ >= 4) \ + || defined __STRICT_ANSI__)) # define _Static_assert(expr, diagnostic) \ extern int (*__Static_assert_function (void)) \ [!!sizeof (struct { int __error_if_negative: (expr) ? 2 : -1; })] diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h index 7e88c8cb9d0..7cf605a5f64 100644 --- a/lib/count-leading-zeros.h +++ b/lib/count-leading-zeros.h @@ -38,7 +38,8 @@ extern "C" { expand to code that computes the number of leading zeros of the local variable 'x' of type TYPE (an unsigned integer type) and return it from the current function. */ -#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \ + || (__clang_major__ >= 4) # define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ return x ? BUILTIN (x) : CHAR_BIT * sizeof x; #elif _MSC_VER diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h index 6c5b75708cf..a9e166aed8c 100644 --- a/lib/count-one-bits.h +++ b/lib/count-one-bits.h @@ -38,7 +38,8 @@ extern "C" { expand to code that computes the number of 1-bits of the local variable 'x' of type TYPE (an unsigned integer type) and return it from the current function. */ -#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#if (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)) \ + || (__clang_major__ >= 4) # define COUNT_ONE_BITS(GCC_BUILTIN, MSC_BUILTIN, TYPE) \ return GCC_BUILTIN (x) #else diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h index 1eb5fb919f4..727b21dcc56 100644 --- a/lib/count-trailing-zeros.h +++ b/lib/count-trailing-zeros.h @@ -38,7 +38,8 @@ extern "C" { expand to code that computes the number of trailing zeros of the local variable 'x' of type TYPE (an unsigned integer type) and return it from the current function. */ -#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \ + || (__clang_major__ >= 4) # define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ return x ? BUILTIN (x) : CHAR_BIT * sizeof x; #elif _MSC_VER diff --git a/lib/dirent.in.h b/lib/dirent.in.h index 6fa44f0d28d..23c4e055774 100644 --- a/lib/dirent.in.h +++ b/lib/dirent.in.h @@ -58,7 +58,7 @@ typedef struct gl_directory DIR; /* The __attribute__ feature is available in gcc versions 2.5 and later. The attribute __pure__ was added in gcc 2.96. */ #ifndef _GL_ATTRIBUTE_PURE -# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) +# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) || defined __clang__ # define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__)) # else # define _GL_ATTRIBUTE_PURE /* empty */ diff --git a/lib/dup2.c b/lib/dup2.c index 9bc3951f3d2..323e19b25ec 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -52,7 +52,7 @@ dup2_nothrow (int fd, int desired_fd) TRY_MSVC_INVAL { - result = dup2 (fd, desired_fd); + result = _dup2 (fd, desired_fd); } CATCH_MSVC_INVAL { @@ -64,7 +64,7 @@ dup2_nothrow (int fd, int desired_fd) return result; } # else -# define dup2_nothrow dup2 +# define dup2_nothrow _dup2 # endif static int diff --git a/lib/fcntl.c b/lib/fcntl.c index 6b9927ec4e5..8cd1531527d 100644 --- a/lib/fcntl.c +++ b/lib/fcntl.c @@ -70,14 +70,14 @@ dupfd (int oldfd, int newfd, int flags) return -1; } if (old_handle == INVALID_HANDLE_VALUE - || (mode = setmode (oldfd, O_BINARY)) == -1) + || (mode = _setmode (oldfd, O_BINARY)) == -1) { /* oldfd is not open, or is an unassigned standard file descriptor. */ errno = EBADF; return -1; } - setmode (oldfd, mode); + _setmode (oldfd, mode); flags |= mode; for (;;) diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h index 0a21c957baf..6f16bc66921 100644 --- a/lib/fcntl.in.h +++ b/lib/fcntl.in.h @@ -97,6 +97,12 @@ _GL_FUNCDECL_RPL (creat, int, (const char *filename, mode_t mode) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (creat, int, (const char *filename, mode_t mode)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef creat +# define creat _creat +# endif +_GL_CXXALIAS_MDA (creat, int, (const char *filename, mode_t mode)); # else _GL_CXXALIAS_SYS (creat, int, (const char *filename, mode_t mode)); # endif @@ -106,6 +112,9 @@ _GL_CXXALIASWARN (creat); /* Assume creat is always declared. */ _GL_WARN_ON_USE (creat, "creat is not always POSIX compliant - " "use gnulib module creat for portability"); +#elif defined _WIN32 && !defined __CYGWIN__ +# undef creat +# define creat _creat #endif #if @GNULIB_FCNTL@ @@ -146,6 +155,12 @@ _GL_WARN_ON_USE (fcntl, "fcntl is not always POSIX compliant - " _GL_FUNCDECL_RPL (open, int, (const char *filename, int flags, ...) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (open, int, (const char *filename, int flags, ...)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef open +# define open _open +# endif +_GL_CXXALIAS_MDA (open, int, (const char *filename, int flags, ...)); # else _GL_CXXALIAS_SYS (open, int, (const char *filename, int flags, ...)); # endif @@ -159,6 +174,9 @@ _GL_CXXALIASWARN (open); /* Assume open is always declared. */ _GL_WARN_ON_USE (open, "open is not always POSIX compliant - " "use gnulib module open for portability"); +#elif defined _WIN32 && !defined __CYGWIN__ +# undef open +# define open _open #endif #if @GNULIB_OPENAT@ diff --git a/lib/getopt-cdefs.in.h b/lib/getopt-cdefs.in.h index c510ab163c3..674838c666a 100644 --- a/lib/getopt-cdefs.in.h +++ b/lib/getopt-cdefs.in.h @@ -57,7 +57,7 @@ #endif #ifndef __THROW -# if defined __cplusplus && __GNUC_PREREQ (2,8) +# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major__ >= 4) # define __THROW throw () # else # define __THROW diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 4dc180d2e33..7b4fc74219f 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -246,9 +246,10 @@ GL_GENERATE_ALLOCA_H = @GL_GENERATE_ALLOCA_H@ GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@ GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@ GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@ -GL_GENERATE_GMP_H = @GL_GENERATE_GMP_H@ +GL_GENERATE_GMP_GMP_H = @GL_GENERATE_GMP_GMP_H@ GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@ GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@ +GL_GENERATE_MINI_GMP_H = @GL_GENERATE_MINI_GMP_H@ GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@ GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@ GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@ @@ -681,7 +682,6 @@ HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@ HAVE_TIMEGM = @HAVE_TIMEGM@ HAVE_TIMEZONE_T = @HAVE_TIMEZONE_T@ HAVE_TYPE_VOLATILE_SIG_ATOMIC_T = @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@ -HAVE_TZSET = @HAVE_TZSET@ HAVE_UNISTD_H = @HAVE_UNISTD_H@ HAVE_UNLINKAT = @HAVE_UNLINKAT@ HAVE_UNLOCKPT = @HAVE_UNLOCKPT@ @@ -1085,7 +1085,6 @@ gamedir = @gamedir@ gamegroup = @gamegroup@ gameuser = @gameuser@ gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@ -gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9 = @gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9@ gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@ gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@ @@ -1159,7 +1158,7 @@ ifeq (,$(OMIT_GNULIB_MODULE_absolute-header)) # Use this preprocessor expression to decide whether #include_next works. # Do not rely on a 'configure'-time test for this, since the expression # might appear in an installed header, which is used by some other compiler. -HAVE_INCLUDE_NEXT = (__GNUC__ || 60000000 <= __DECC_VER) +HAVE_INCLUDE_NEXT = (__GNUC__ || __clang__ || 60000000 <= __DECC_VER) endif ## end gnulib module absolute-header @@ -2021,15 +2020,22 @@ ifeq (,$(OMIT_GNULIB_MODULE_libgmp)) BUILT_SOURCES += $(GMP_H) +ifneq (,$(GL_GENERATE_MINI_GMP_H)) # Build gmp.h as a wrapper for mini-gmp.h when using mini-gmp. -ifneq (,$(GL_GENERATE_GMP_H)) gmp.h: $(top_builddir)/config.status echo '#include "mini-gmp.h"' >$@-t mv $@-t $@ else +ifneq (,$(GL_GENERATE_GMP_GMP_H)) +# Build gmp.h as a wrapper for gmp/gmp.h. +gmp.h: $(top_builddir)/config.status + echo '#include <gmp/gmp.h>' >$@-t + mv $@-t $@ +else gmp.h: $(top_builddir)/config.status rm -f $@ endif +endif MOSTLYCLEANFILES += gmp.h gmp.h-t EXTRA_DIST += mini-gmp-gnulib.c mini-gmp.c mini-gmp.h @@ -3178,7 +3184,6 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $( -e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \ -e 's|@''HAVE_TIMEGM''@|$(HAVE_TIMEGM)|g' \ -e 's|@''HAVE_TIMEZONE_T''@|$(HAVE_TIMEZONE_T)|g' \ - -e 's|@''HAVE_TZSET''@|$(HAVE_TZSET)|g' \ -e 's|@''REPLACE_CTIME''@|$(REPLACE_CTIME)|g' \ -e 's|@''REPLACE_GMTIME''@|$(REPLACE_GMTIME)|g' \ -e 's|@''REPLACE_LOCALTIME''@|$(REPLACE_LOCALTIME)|g' \ diff --git a/lib/ignore-value.h b/lib/ignore-value.h index 7a922268431..ec3288f0dfc 100644 --- a/lib/ignore-value.h +++ b/lib/ignore-value.h @@ -39,8 +39,9 @@ versions 3.4 and newer have __attribute__ ((__warn_unused_result__)) which may cause unwanted diagnostics in that case. Use __typeof__ and __extension__ to work around the problem, if the workaround is - known to be needed. */ -#if 3 < __GNUC__ + (4 <= __GNUC_MINOR__) + known to be needed. + The workaround is not needed with clang. */ +#if (3 < __GNUC__ + (4 <= __GNUC_MINOR__)) && !defined __clang__ # define ignore_value(x) \ (__extension__ ({ __typeof__ (x) __x = (x); (void) __x; })) #else diff --git a/lib/intprops.h b/lib/intprops.h index dfbcaae73e3..f2f70b3e733 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -86,6 +86,7 @@ /* Does the __typeof__ keyword work? This could be done by 'configure', but for now it's easier to do it by hand. */ #if (2 <= __GNUC__ \ + || (4 <= __clang_major__) \ || (1210 <= __IBMC__ && defined __IBM__TYPEOF__) \ || (0x5110 <= __SUNPRO_C && !__STDC__)) # define _GL_HAVE___TYPEOF__ 1 @@ -239,7 +240,7 @@ #endif /* True if __builtin_add_overflow_p (A, B, C) works, and similarly for - __builtin_mul_overflow_p and __builtin_mul_overflow_p. */ + __builtin_sub_overflow_p and __builtin_mul_overflow_p. */ #define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__) /* The _GL*_OVERFLOW macros have the same restrictions as the @@ -395,7 +396,7 @@ For now, assume all versions of GCC-like compilers generate bogus warnings for _Generic. This matters only for compilers that lack relevant builtins. */ -#if __GNUC__ +#if __GNUC__ || defined __clang__ # define _GL__GENERIC_BOGUS 1 #else # define _GL__GENERIC_BOGUS 0 diff --git a/lib/malloca.h b/lib/malloca.h index cfcd4de4ad8..ccc485a6a4d 100644 --- a/lib/malloca.h +++ b/lib/malloca.h @@ -89,7 +89,7 @@ extern void freea (void *p); /* ------------------- Auxiliary, non-public definitions ------------------- */ /* Determine the alignment of a type at compile time. */ -#if defined __GNUC__ || defined __IBM__ALIGNOF__ +#if defined __GNUC__ || defined __clang__ || defined __IBM__ALIGNOF__ # define sa_alignof __alignof__ #elif defined __cplusplus template <class type> struct sa_alignof_helper { char __slot1; type __slot2; }; diff --git a/lib/md5.h b/lib/md5.h index 3c6048242b0..c728ba1b6f2 100644 --- a/lib/md5.h +++ b/lib/md5.h @@ -40,7 +40,7 @@ #endif #ifndef __THROW -# if defined __cplusplus && __GNUC_PREREQ (2,8) +# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major__ >= 4) # define __THROW throw () # else # define __THROW diff --git a/lib/mktime.c b/lib/mktime.c index 92c00b2b14b..5b4c144ecad 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -94,7 +94,7 @@ my_tzset (void) const char *tz = getenv ("TZ"); if (tz != NULL && strchr (tz, '/') != NULL) _putenv ("TZ="); -# elif HAVE_TZSET +# else tzset (); # endif } diff --git a/lib/nstrftime.c b/lib/nstrftime.c index 2816cf4d58b..7d5a97f7635 100644 --- a/lib/nstrftime.c +++ b/lib/nstrftime.c @@ -21,7 +21,6 @@ # define HAVE_TM_GMTOFF 1 # define HAVE_TM_ZONE 1 # define HAVE_TZNAME 1 -# define HAVE_TZSET 1 # include "../locale/localeinfo.h" #else # include <config.h> @@ -34,6 +33,7 @@ #endif #include <ctype.h> +#include <errno.h> #include <time.h> #if HAVE_TZNAME && !HAVE_DECL_TZNAME @@ -163,7 +163,10 @@ extern char *tzname[]; size_t _w = pad == L_('-') || width < 0 ? 0 : width; \ size_t _incr = _n < _w ? _w : _n; \ if (_incr >= maxsize - i) \ - return 0; \ + { \ + errno = ERANGE; \ + return 0; \ + } \ if (p) \ { \ if (_n < _w) \ @@ -365,7 +368,7 @@ tm_diff (const struct tm *a, const struct tm *b) #define ISO_WEEK1_WDAY 4 /* Thursday */ #define YDAY_MINIMUM (-366) static int iso_week_days (int, int); -#ifdef __GNUC__ +#if defined __GNUC__ || defined __clang__ __inline__ #endif static int @@ -389,7 +392,6 @@ iso_week_days (int yday, int wday) #endif #ifdef my_strftime -# undef HAVE_TZSET # define extra_args , tz, ns # define extra_args_spec , timezone_t tz, int ns #else @@ -449,6 +451,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) size_t maxsize = (size_t) -1; #endif + int saved_errno = errno; int hour12 = tp->tm_hour; #ifdef _NL_CURRENT /* We cannot make the following values variables since we must delay @@ -523,7 +526,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) { /* POSIX.1 requires that local time zone information be used as though strftime called tzset. */ -# if HAVE_TZSET +# ifndef my_strftime if (!*tzset_called) { tzset (); @@ -1188,7 +1191,13 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) time_t t; ltm = *tp; + ltm.tm_yday = -1; t = mktime_z (tz, <m); + if (ltm.tm_yday < 0) + { + errno = EOVERFLOW; + return 0; + } /* Generate string value for T using time_t arithmetic; this works even if sizeof (long) < sizeof (time_t). */ @@ -1417,7 +1426,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) /* POSIX.1 requires that local time zone information be used as though strftime called tzset. */ -# if HAVE_TZSET +# ifndef my_strftime if (!*tzset_called) { tzset (); @@ -1486,5 +1495,6 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) *p = L_('\0'); #endif + errno = saved_errno; return i; } diff --git a/lib/open.c b/lib/open.c index 751b42d7dcf..0f7c6e9b9d3 100644 --- a/lib/open.c +++ b/lib/open.c @@ -30,7 +30,11 @@ static int orig_open (const char *filename, int flags, mode_t mode) { +#if defined _WIN32 && !defined __CYGWIN__ + return _open (filename, flags, mode); +#else return open (filename, flags, mode); +#endif } /* Specification. */ diff --git a/lib/regcomp.c b/lib/regcomp.c index 84044be5e09..a4b95b0b2ff 100644 --- a/lib/regcomp.c +++ b/lib/regcomp.c @@ -558,7 +558,7 @@ weak_alias (__regerror, regerror) static const bitset_t utf8_sb_map = { /* Set the first 128 bits. */ -# if defined __GNUC__ && !defined __STRICT_ANSI__ +# if (defined __GNUC__ || __clang_major__ >= 4) && !defined __STRICT_ANSI__ [0 ... 0x80 / BITSET_WORD_BITS - 1] = BITSET_WORD_MAX # else # if 4 * BITSET_WORD_BITS < ASCII_CHARS diff --git a/lib/regex.h b/lib/regex.h index 610f139eb39..306521a3e8a 100644 --- a/lib/regex.h +++ b/lib/regex.h @@ -612,7 +612,9 @@ extern int re_exec (const char *); 'configure' might #define 'restrict' to those words, so pick a different name. */ #ifndef _Restrict_ -# if defined __restrict || 2 < __GNUC__ + (95 <= __GNUC_MINOR__) +# if defined __restrict \ + || 2 < __GNUC__ + (95 <= __GNUC_MINOR__) \ + || __clang_major__ >= 3 # define _Restrict_ __restrict # elif 199901L <= __STDC_VERSION__ || defined restrict # define _Restrict_ restrict @@ -620,13 +622,18 @@ extern int re_exec (const char *); # define _Restrict_ # endif #endif -/* For [restrict], use glibc's __restrict_arr if available. - Otherwise, GCC 3.1 (not in C++ mode) and C99 support [restrict]. */ +/* For the ISO C99 syntax + array_name[restrict] + use glibc's __restrict_arr if available. + Otherwise, GCC 3.1 and clang support this syntax (but not in C++ mode). + Other ISO C99 compilers support it as well. */ #ifndef _Restrict_arr_ # ifdef __restrict_arr # define _Restrict_arr_ __restrict_arr -# elif ((199901L <= __STDC_VERSION__ || 3 < __GNUC__ + (1 <= __GNUC_MINOR__)) \ - && !defined __GNUG__) +# elif ((199901L <= __STDC_VERSION__ \ + || 3 < __GNUC__ + (1 <= __GNUC_MINOR__) \ + || __clang_major__ >= 3) \ + && !defined __cplusplus) # define _Restrict_arr_ _Restrict_ # else # define _Restrict_arr_ diff --git a/lib/regex_internal.h b/lib/regex_internal.h index f6ebfb003e8..0c72e3f7b01 100644 --- a/lib/regex_internal.h +++ b/lib/regex_internal.h @@ -335,7 +335,7 @@ typedef struct Idx idx; /* for BACK_REF */ re_context_type ctx_type; /* for ANCHOR */ } opr; -#if __GNUC__ >= 2 && !defined __STRICT_ANSI__ +#if (__GNUC__ >= 2 || defined __clang__) && !defined __STRICT_ANSI__ re_token_type_t type : 8; #else re_token_type_t type; @@ -841,10 +841,10 @@ re_string_elem_size_at (const re_string_t *pstr, Idx idx) #endif /* RE_ENABLE_I18N */ #ifndef FALLTHROUGH -# if __GNUC__ < 7 -# define FALLTHROUGH ((void) 0) -# else +# if (__GNUC__ >= 7) || (__clang_major__ >= 10) # define FALLTHROUGH __attribute__ ((__fallthrough__)) +# else +# define FALLTHROUGH ((void) 0) # endif #endif diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h index cd786bed2cd..e4809b401f7 100644 --- a/lib/stdalign.in.h +++ b/lib/stdalign.in.h @@ -34,11 +34,12 @@ requirement of a structure member (i.e., slot or field) that is of type TYPE, as an integer constant expression. - This differs from GCC's __alignof__ operator, which can yield a - better-performing alignment for an object of that type. For - example, on x86 with GCC, __alignof__ (double) and __alignof__ - (long long) are 8, whereas alignof (double) and alignof (long long) - are 4 unless the option '-malign-double' is used. + This differs from GCC's and clang's __alignof__ operator, which can + yield a better-performing alignment for an object of that type. For + example, on x86 with GCC and on Linux/x86 with clang, + __alignof__ (double) and __alignof__ (long long) are 8, whereas + alignof (double) and alignof (long long) are 4 unless the option + '-malign-double' is used. The result cannot be used as a value for an 'enum' constant, if you want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. @@ -55,7 +56,8 @@ /* 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>. */ #if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ - || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9))) + || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ + && !defined __clang__)) # ifdef __cplusplus # if 201103 <= __cplusplus # define _Alignof(type) alignof (type) @@ -102,8 +104,9 @@ # define _Alignas(a) alignas (a) # elif ((defined __APPLE__ && defined __MACH__ \ ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \ - : __GNUC__ && !defined __ibmxl__) \ - || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ + : __GNUC__ && !defined __ibmxl__) \ + || (4 <= __clang_major__) \ + || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__) # define _Alignas(a) __attribute__ ((__aligned__ (a))) # elif 1300 <= _MSC_VER diff --git a/lib/stddef.in.h b/lib/stddef.in.h index 2e50a1f01e8..87b46d53204 100644 --- a/lib/stddef.in.h +++ b/lib/stddef.in.h @@ -97,7 +97,7 @@ and the C11 standard allows this. Work around this problem by using __alignof__ (which returns 8 for double) rather than _Alignof (which returns 4), and align each union member accordingly. */ -# ifdef __GNUC__ +# if defined __GNUC__ || (__clang_major__ >= 4) # define _GL_STDDEF_ALIGNAS(type) \ __attribute__ ((__aligned__ (__alignof__ (type)))) # else diff --git a/lib/stdint.in.h b/lib/stdint.in.h index 994c0c777c0..63fa1aa628f 100644 --- a/lib/stdint.in.h +++ b/lib/stdint.in.h @@ -302,12 +302,11 @@ typedef gl_uint_fast32_t gl_uint_fast16_t; /* kLIBC's <stdint.h> defines _INTPTR_T_DECLARED and needs its own definitions of intptr_t and uintptr_t (which use int and unsigned) to avoid clashes with declarations of system functions like sbrk. - Similarly, mingw 5.22 <crtdefs.h> defines _INTPTR_T_DEFINED and - _UINTPTR_T_DEFINED and needs its own definitions of intptr_t and + Similarly, MinGW WSL-5.4.1 <stdint.h> needs its own intptr_t and uintptr_t to avoid conflicting declarations of system functions like _findclose in <io.h>. */ # if !((defined __KLIBC__ && defined _INTPTR_T_DECLARED) \ - || (defined __MINGW32__ && defined _INTPTR_T_DEFINED && defined _UINTPTR_T_DEFINED)) + || defined __MINGW32__) # undef intptr_t # undef uintptr_t # ifdef _WIN64 diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 6c338dd6c0b..6d12cd826de 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -63,7 +63,7 @@ gnulib and libintl do '#define printf __printf__' when they override the 'printf' function. */ #ifndef _GL_ATTRIBUTE_FORMAT -# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7) +# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7) || defined __clang__ # define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec)) # else # define _GL_ATTRIBUTE_FORMAT(spec) /* empty */ @@ -215,6 +215,11 @@ _GL_WARN_ON_USE (fclose, "fclose is not always POSIX compliant - " "use gnulib module fclose for portable POSIX compliance"); #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef fcloseall +# define fcloseall _fcloseall +#endif + #if @GNULIB_FDOPEN@ # if @REPLACE_FDOPEN@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) @@ -224,6 +229,12 @@ _GL_WARN_ON_USE (fclose, "fclose is not always POSIX compliant - " _GL_FUNCDECL_RPL (fdopen, FILE *, (int fd, const char *mode) _GL_ARG_NONNULL ((2))); _GL_CXXALIAS_RPL (fdopen, FILE *, (int fd, const char *mode)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef fdopen +# define fdopen _fdopen +# endif +_GL_CXXALIAS_MDA (fdopen, FILE *, (int fd, const char *mode)); # else _GL_CXXALIAS_SYS (fdopen, FILE *, (int fd, const char *mode)); # endif @@ -233,6 +244,9 @@ _GL_CXXALIASWARN (fdopen); /* Assume fdopen is always declared. */ _GL_WARN_ON_USE (fdopen, "fdopen on native Windows platforms is not POSIX compliant - " "use gnulib module fdopen for portability"); +#elif defined _WIN32 && !defined __CYGWIN__ +# undef fdopen +# define fdopen _fdopen #endif #if @GNULIB_FFLUSH@ @@ -297,6 +311,11 @@ _GL_CXXALIASWARN (fgets); # endif #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef fileno +# define fileno _fileno +#endif + #if @GNULIB_FOPEN@ # if @REPLACE_FOPEN@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) @@ -824,6 +843,11 @@ _GL_WARN_ON_USE (getline, "getline is unportable - " _GL_WARN_ON_USE (gets, "gets is a security hole - use fgets instead"); #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef getw +# define getw _getw +#endif + #if @GNULIB_OBSTACK_PRINTF@ || @GNULIB_OBSTACK_PRINTF_POSIX@ struct obstack; /* Grow an obstack with formatted output. Return the number of @@ -940,7 +964,7 @@ _GL_WARN_ON_USE (popen, "popen is buggy on some platforms - " #if @GNULIB_PRINTF_POSIX@ || @GNULIB_PRINTF@ # if (@GNULIB_PRINTF_POSIX@ && @REPLACE_PRINTF@) \ || (@GNULIB_PRINTF@ && @REPLACE_STDIO_WRITE_FUNCS@ && (@GNULIB_STDIO_H_NONBLOCKING@ || @GNULIB_STDIO_H_SIGPIPE@)) -# if defined __GNUC__ +# if defined __GNUC__ || defined __clang__ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) /* Don't break __attribute__((format(printf,M,N))). */ # define printf __printf__ @@ -1037,6 +1061,11 @@ _GL_CXXALIASWARN (puts); # endif #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef putw +# define putw _putw +#endif + #if @GNULIB_REMOVE@ # if @REPLACE_REMOVE@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) @@ -1114,7 +1143,7 @@ _GL_WARN_ON_USE (renameat, "renameat is not portable - " #if @GNULIB_SCANF@ # if @REPLACE_STDIO_READ_FUNCS@ && @GNULIB_STDIO_H_NONBLOCKING@ -# if defined __GNUC__ +# if defined __GNUC__ || defined __clang__ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # undef scanf /* Don't break __attribute__((format(scanf,M,N))). */ @@ -1170,7 +1199,9 @@ _GL_CXXALIAS_SYS (snprintf, int, (char *restrict str, size_t size, const char *restrict format, ...)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (snprintf); +# endif #elif defined GNULIB_POSIXCHECK # undef snprintf # if HAVE_RAW_DECL_SNPRINTF @@ -1214,6 +1245,11 @@ _GL_WARN_ON_USE (sprintf, "sprintf is not always POSIX compliant - " "POSIX compliance"); #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef tempnam +# define tempnam _tempnam +#endif + #if @GNULIB_TMPFILE@ # if @REPLACE_TMPFILE@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) @@ -1382,7 +1418,9 @@ _GL_CXXALIAS_SYS (vfscanf, int, (FILE *restrict stream, const char *restrict format, va_list args)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (vfscanf); +# endif #endif #if @GNULIB_VPRINTF_POSIX@ || @GNULIB_VPRINTF@ @@ -1436,7 +1474,9 @@ _GL_CXXALIAS_RPL (vscanf, int, (const char *restrict format, va_list args)); # else _GL_CXXALIAS_SYS (vscanf, int, (const char *restrict format, va_list args)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (vscanf); +# endif #endif #if @GNULIB_VSNPRINTF@ @@ -1464,7 +1504,9 @@ _GL_CXXALIAS_SYS (vsnprintf, int, (char *restrict str, size_t size, const char *restrict format, va_list args)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (vsnprintf); +# endif #elif defined GNULIB_POSIXCHECK # undef vsnprintf # if HAVE_RAW_DECL_VSNPRINTF diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 59f9e6c71d1..47a1309e633 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -102,7 +102,7 @@ struct random_data /* The __attribute__ feature is available in gcc versions 2.5 and later. The attribute __pure__ was added in gcc 2.96. */ #ifndef _GL_ATTRIBUTE_PURE -# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) +# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) || defined __clang__ # define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__)) # else # define _GL_ATTRIBUTE_PURE /* empty */ @@ -217,6 +217,21 @@ _GL_WARN_ON_USE (canonicalize_file_name, # endif #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef ecvt +# define ecvt _ecvt +#endif + +#if defined _WIN32 && !defined __CYGWIN__ +# undef fcvt +# define fcvt _fcvt +#endif + +#if defined _WIN32 && !defined __CYGWIN__ +# undef gcvt +# define gcvt _gcvt +#endif + #if @GNULIB_GETLOADAVG@ /* Store max(NELEM,3) load average numbers in LOADAVG[]. The three numbers are the load average of the last 1 minute, the last 5 @@ -468,6 +483,11 @@ _GL_WARN_ON_USE (mkstemps, "mkstemps is unportable - " # endif #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef mktemp +# define mktemp _mktemp +#endif + #if @GNULIB_POSIX_OPENPT@ /* Return an FD open to the master side of a pseudo-terminal. Flags should include O_RDWR, and may also include O_NOCTTY. */ @@ -546,10 +566,19 @@ _GL_WARN_ON_USE (ptsname_r, "ptsname_r is not portable - " # endif _GL_FUNCDECL_RPL (putenv, int, (char *string) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (putenv, int, (char *string)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef putenv +# define putenv _putenv +# endif +_GL_CXXALIAS_MDA (putenv, int, (char *string)); # else _GL_CXXALIAS_SYS (putenv, int, (char *string)); # endif _GL_CXXALIASWARN (putenv); +#elif defined _WIN32 && !defined __CYGWIN__ +# undef putenv +# define putenv _putenv #endif #if @GNULIB_QSORT_R@ diff --git a/lib/strftime.h b/lib/strftime.h index e8501631573..fe0c4195a59 100644 --- a/lib/strftime.h +++ b/lib/strftime.h @@ -24,7 +24,12 @@ extern "C" { /* Just like strftime, but with two more arguments: POSIX requires that strftime use the local timezone information. Use the timezone __TZ instead. Use __NS as the number of - nanoseconds in the %N directive. */ + nanoseconds in the %N directive. + + On error, set errno and return 0. Otherwise, return the number of + bytes generated (not counting the trailing NUL), preserving errno + if the number is 0. This errno behavior is in draft POSIX 202x + plus some requested changes to POSIX. */ size_t nstrftime (char *restrict, size_t, char const *, struct tm const *, timezone_t __tz, int __ns); diff --git a/lib/string.in.h b/lib/string.in.h index aa9802791ee..7d83668f6ec 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -55,7 +55,7 @@ /* The __attribute__ feature is available in gcc versions 2.5 and later. The attribute __pure__ was added in gcc 2.96. */ #ifndef _GL_ATTRIBUTE_PURE -# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) +# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96) || defined __clang__ # define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__)) # else # define _GL_ATTRIBUTE_PURE /* empty */ @@ -123,6 +123,12 @@ _GL_WARN_ON_USE (ffsll, "ffsll is not portable - use the ffsll module"); #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef memccpy +# define memccpy _memccpy +#endif + + /* Return the first instance of C within N bytes of S, or NULL. */ #if @GNULIB_MEMCHR@ # if @REPLACE_MEMCHR@ @@ -329,7 +335,8 @@ _GL_WARN_ON_USE (stpncpy, "stpncpy is unportable - " GB18030 and the character to be searched is a digit. */ # undef strchr /* Assume strchr is always declared. */ -_GL_WARN_ON_USE_CXX (strchr, const char *, (const char *, int), +_GL_WARN_ON_USE_CXX (strchr, + const char *, char *, (const char *, int), "strchr cannot work correctly on character strings " "in some multibyte locales - " "use mbschr if you care about internationalization"); @@ -383,6 +390,12 @@ _GL_WARN_ON_USE (strchrnul, "strchrnul is unportable - " # endif _GL_FUNCDECL_RPL (strdup, char *, (char const *__s) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (strdup, char *, (char const *__s)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef strdup +# define strdup _strdup +# endif +_GL_CXXALIAS_MDA (strdup, char *, (char const *__s)); # else # if defined __cplusplus && defined GNULIB_NAMESPACE && defined strdup /* strdup exists as a function and as a macro. Get rid of the macro. */ @@ -400,6 +413,9 @@ _GL_CXXALIASWARN (strdup); _GL_WARN_ON_USE (strdup, "strdup is unportable - " "use gnulib module strdup for portability"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef strdup +# define strdup _strdup #endif /* Append no more than N characters from SRC onto DEST. */ @@ -524,7 +540,8 @@ _GL_CXXALIASWARN (strpbrk); locale encoding is GB18030 and one of the characters to be searched is a digit. */ # undef strpbrk -_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *), +_GL_WARN_ON_USE_CXX (strpbrk, + const char *, char *, (const char *, const char *), "strpbrk cannot work correctly on character strings " "in multibyte locales - " "use mbspbrk if you care about internationalization"); @@ -532,7 +549,8 @@ _GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *), #elif defined GNULIB_POSIXCHECK # undef strpbrk # if HAVE_RAW_DECL_STRPBRK -_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *), +_GL_WARN_ON_USE_CXX (strpbrk, + const char *, char *, (const char *, const char *), "strpbrk is unportable - " "use gnulib module strpbrk for portability"); # endif @@ -553,7 +571,8 @@ _GL_WARN_ON_USE (strspn, "strspn cannot work correctly on character strings " GB18030 and the character to be searched is a digit. */ # undef strrchr /* Assume strrchr is always declared. */ -_GL_WARN_ON_USE_CXX (strrchr, const char *, (const char *, int), +_GL_WARN_ON_USE_CXX (strrchr, + const char *, char *, (const char *, int), "strrchr cannot work correctly on character strings " "in some multibyte locales - " "use mbsrchr if you care about internationalization"); diff --git a/lib/sys_random.in.h b/lib/sys_random.in.h index f14ac1f5723..a82d716de2e 100644 --- a/lib/sys_random.in.h +++ b/lib/sys_random.in.h @@ -23,6 +23,10 @@ #if @HAVE_SYS_RANDOM_H@ +/* On uClibc, <sys/random.h> assumes prior inclusion of <stddef.h>. */ +# if defined __UCLIBC__ +# include <stddef.h> +# endif /* On Mac OS X 10.5, <sys/random.h> assumes prior inclusion of <sys/types.h>. On Max OS X 10.13, <sys/random.h> assumes prior inclusion of a file that includes <Availability.h>, such as <stdlib.h> or <unistd.h>. */ diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h index 7a7b157d545..72cb9ba7b0f 100644 --- a/lib/sys_select.in.h +++ b/lib/sys_select.in.h @@ -177,14 +177,14 @@ rpl_fd_isset (SOCKET fd, fd_set * set) # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # undef close # define close close_used_without_including_unistd_h -# else +# elif !defined __clang__ _GL_WARN_ON_USE (close, "close() used without including <unistd.h>"); # endif # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # undef gethostname # define gethostname gethostname_used_without_including_unistd_h -# else +# elif !defined __clang__ _GL_WARN_ON_USE (gethostname, "gethostname() used without including <unistd.h>"); # endif @@ -219,7 +219,7 @@ rpl_fd_isset (SOCKET fd, fd_set * set) # define setsockopt setsockopt_used_without_including_sys_socket_h # undef shutdown # define shutdown shutdown_used_without_including_sys_socket_h -# else +# elif !defined __clang__ _GL_WARN_ON_USE (socket, "socket() used without including <sys/socket.h>"); _GL_WARN_ON_USE (connect, diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index 89e167f6d1c..3e0e4b27b7e 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -391,6 +391,12 @@ struct stat #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef chmod +# define chmod _chmod +#endif + + #if @GNULIB_FCHMODAT@ # if @REPLACE_FCHMODAT@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) @@ -432,7 +438,9 @@ _GL_CXXALIAS_RPL (fstat, int, (int fd, struct stat *buf)); # else _GL_CXXALIAS_SYS (fstat, int, (int fd, struct stat *buf)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (fstat); +# endif #elif @GNULIB_OVERRIDES_STRUCT_STAT@ # undef fstat # define fstat fstat_used_without_requesting_gnulib_module_fstat @@ -800,6 +808,12 @@ _GL_WARN_ON_USE (stat, "stat is unportable - " #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef umask +# define umask _umask +#endif + + #if @GNULIB_UTIMENSAT@ /* Use the rpl_ prefix also on Solaris <= 9, because on Solaris 9 our utimensat implementation relies on futimesat, which on Solaris 10 makes an invocation diff --git a/lib/sys_time.in.h b/lib/sys_time.in.h index d30b26719b2..1c12d5f13d7 100644 --- a/lib/sys_time.in.h +++ b/lib/sys_time.in.h @@ -135,7 +135,7 @@ _GL_WARN_ON_USE (gettimeofday, "gettimeofday is unportable - " # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # undef close # define close close_used_without_including_unistd_h -# else +# elif !defined __clang__ _GL_WARN_ON_USE (close, "close() used without including <unistd.h>"); # endif diff --git a/lib/time.in.h b/lib/time.in.h index 1d11650e77f..32e6ec03ef4 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -135,13 +135,19 @@ _GL_CXXALIASWARN (nanosleep); # endif _GL_FUNCDECL_RPL (tzset, void, (void)); _GL_CXXALIAS_RPL (tzset, void, (void)); -# else -# if ! @HAVE_TZSET@ -_GL_FUNCDECL_SYS (tzset, void, (void)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef tzset +# define tzset _tzset # endif +_GL_CXXALIAS_MDA (tzset, void, (void)); +# else _GL_CXXALIAS_SYS (tzset, void, (void)); # endif _GL_CXXALIASWARN (tzset); +# elif defined _WIN32 && !defined __CYGWIN__ +# undef tzset +# define tzset _tzset # endif /* Return the 'time_t' representation of TP and normalize TP. */ diff --git a/lib/time_rz.c b/lib/time_rz.c index 5d85963c9ed..95438cf876e 100644 --- a/lib/time_rz.c +++ b/lib/time_rz.c @@ -54,31 +54,6 @@ enum { ABBR_SIZE_MIN = DEFAULT_MXFAST - offsetof (struct tm_zone, abbrs) }; matters; the pointer is never dereferenced. */ static timezone_t const local_tz = (timezone_t) 1; -#if HAVE_TM_ZONE || HAVE_TZNAME - -/* Return true if the values A and B differ according to the rules for - tm_isdst: A and B differ if one is zero and the other positive. */ -static bool -isdst_differ (int a, int b) -{ - return !a != !b && 0 <= a && 0 <= b; -} - -/* Return true if A and B are equal. */ -static int -equal_tm (const struct tm *a, const struct tm *b) -{ - return ! ((a->tm_sec ^ b->tm_sec) - | (a->tm_min ^ b->tm_min) - | (a->tm_hour ^ b->tm_hour) - | (a->tm_mday ^ b->tm_mday) - | (a->tm_mon ^ b->tm_mon) - | (a->tm_year ^ b->tm_year) - | isdst_differ (a->tm_isdst, b->tm_isdst)); -} - -#endif - /* Copy to ABBRS the abbreviation at ABBR with size ABBR_SIZE (this includes its trailing null byte). Append an extra null byte to mark the end of ABBRS. */ @@ -327,17 +302,25 @@ mktime_z (timezone_t tz, struct tm *tm) timezone_t old_tz = set_tz (tz); if (old_tz) { - time_t t = mktime (tm); -#if HAVE_TM_ZONE || HAVE_TZNAME - time_t badtime = -1; struct tm tm_1; - if ((t != badtime - || (localtime_r (&t, &tm_1) && equal_tm (tm, &tm_1))) - && !save_abbr (tz, tm)) - t = badtime; + tm_1.tm_sec = tm->tm_sec; + tm_1.tm_min = tm->tm_min; + tm_1.tm_hour = tm->tm_hour; + tm_1.tm_mday = tm->tm_mday; + tm_1.tm_mon = tm->tm_mon; + tm_1.tm_year = tm->tm_year; + tm_1.tm_yday = -1; + tm_1.tm_isdst = tm->tm_isdst; + time_t t = mktime (&tm_1); + bool ok = 0 <= tm_1.tm_yday; +#if HAVE_TM_ZONE || HAVE_TZNAME + ok = ok && save_abbr (tz, &tm_1); #endif - if (revert_tz (old_tz)) - return t; + if (revert_tz (old_tz) && ok) + { + *tm = tm_1; + return t; + } } return -1; } diff --git a/lib/unistd.in.h b/lib/unistd.in.h index a81a14fe873..357a35e3881 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -273,6 +273,12 @@ _GL_INLINE_HEADER_BEGIN _GL_FUNCDECL_RPL (access, int, (const char *file, int mode) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (access, int, (const char *file, int mode)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef access +# define access _access +# endif +_GL_CXXALIAS_MDA (access, int, (const char *file, int mode)); # else _GL_CXXALIAS_SYS (access, int, (const char *file, int mode)); # endif @@ -286,11 +292,22 @@ _GL_WARN_ON_USE (access, "access does not always support X_OK - " "also, this function is a security risk - " "use the gnulib module faccessat instead"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef access +# define access _access #endif #if @GNULIB_CHDIR@ +# if defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef chdir +# define chdir _chdir +# endif +_GL_CXXALIAS_MDA (chdir, int, (const char *file)); +# else _GL_CXXALIAS_SYS (chdir, int, (const char *file) _GL_ARG_NONNULL ((1))); +# endif _GL_CXXALIASWARN (chdir); #elif defined GNULIB_POSIXCHECK # undef chdir @@ -298,6 +315,9 @@ _GL_CXXALIASWARN (chdir); _GL_WARN_ON_USE (chown, "chdir is not always in <unistd.h> - " "use gnulib module chdir for portability"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef chdir +# define chdir _chdir #endif @@ -342,6 +362,12 @@ _GL_WARN_ON_USE (chown, "chown fails to follow symlinks on some systems and " # endif _GL_FUNCDECL_RPL (close, int, (int fd)); _GL_CXXALIAS_RPL (close, int, (int fd)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef close +# define close _close +# endif +_GL_CXXALIAS_MDA (close, int, (int fd)); # else _GL_CXXALIAS_SYS (close, int, (int fd)); # endif @@ -354,6 +380,9 @@ _GL_CXXALIASWARN (close); /* Assume close is always declared. */ _GL_WARN_ON_USE (close, "close does not portably work on sockets - " "use gnulib module close for portability"); +#elif defined _WIN32 && !defined __CYGWIN__ +# undef close +# define close _close #endif @@ -382,6 +411,12 @@ _GL_WARN_ON_USE (copy_file_range, # endif _GL_FUNCDECL_RPL (dup, int, (int oldfd)); _GL_CXXALIAS_RPL (dup, int, (int oldfd)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef dup +# define dup _dup +# endif +_GL_CXXALIAS_MDA (dup, int, (int oldfd)); # else _GL_CXXALIAS_SYS (dup, int, (int oldfd)); # endif @@ -392,6 +427,9 @@ _GL_CXXALIASWARN (dup); _GL_WARN_ON_USE (dup, "dup is unportable - " "use gnulib module dup for portability"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef dup +# define dup _dup #endif @@ -407,6 +445,12 @@ _GL_WARN_ON_USE (dup, "dup is unportable - " # endif _GL_FUNCDECL_RPL (dup2, int, (int oldfd, int newfd)); _GL_CXXALIAS_RPL (dup2, int, (int oldfd, int newfd)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef dup2 +# define dup2 _dup2 +# endif +_GL_CXXALIAS_MDA (dup2, int, (int oldfd, int newfd)); # else _GL_CXXALIAS_SYS (dup2, int, (int oldfd, int newfd)); # endif @@ -417,6 +461,9 @@ _GL_CXXALIASWARN (dup2); _GL_WARN_ON_USE (dup2, "dup2 is unportable - " "use gnulib module dup2 for portability"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef dup2 +# define dup2 _dup2 #endif @@ -517,6 +564,43 @@ _GL_WARN_ON_USE (euidaccess, "euidaccess is unportable - " #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef execl +# define execl _execl +#endif + +#if defined _WIN32 && !defined __CYGWIN__ +# undef execle +# define execle _execle +#endif + +#if defined _WIN32 && !defined __CYGWIN__ +# undef execlp +# define execlp _execlp +#endif + + +#if defined _WIN32 && !defined __CYGWIN__ +# undef execv +# define execv _execv +#endif + +#if defined _WIN32 && !defined __CYGWIN__ +# undef execve +# define execve _execve +#endif + +#if defined _WIN32 && !defined __CYGWIN__ +# undef execvp +# define execvp _execvp +#endif + +#if defined _WIN32 && !defined __CYGWIN__ +# undef execvpe +# define execvpe _execvpe +#endif + + #if @GNULIB_FACCESSAT@ # if @REPLACE_FACCESSAT@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) @@ -692,6 +776,12 @@ _GL_WARN_ON_USE (ftruncate, "ftruncate is unportable - " # endif _GL_FUNCDECL_RPL (getcwd, char *, (char *buf, size_t size)); _GL_CXXALIAS_RPL (getcwd, char *, (char *buf, size_t size)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getcwd +# define getcwd _getcwd +# endif +_GL_CXXALIAS_MDA (getcwd, char *, (char *buf, size_t size)); # else /* Need to cast, because on mingw, the second parameter is int size. */ @@ -704,6 +794,9 @@ _GL_CXXALIASWARN (getcwd); _GL_WARN_ON_USE (getcwd, "getcwd is unportable - " "use gnulib module getcwd for portability"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef getcwd +# define getcwd _getcwd #endif @@ -1038,6 +1131,12 @@ _GL_WARN_ON_USE (getpass, "getpass is unportable - " #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef getpid +# define getpid _getpid +#endif + + #if @GNULIB_GETUSERSHELL@ /* Return the next valid login shell on the system, or NULL when the end of the list has been reached. */ @@ -1110,6 +1209,12 @@ _GL_WARN_ON_USE (group_member, "group_member is unportable - " # endif _GL_FUNCDECL_RPL (isatty, int, (int fd)); _GL_CXXALIAS_RPL (isatty, int, (int fd)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef isatty +# define isatty _isatty +# endif +_GL_CXXALIAS_MDA (isatty, int, (int fd)); # else _GL_CXXALIAS_SYS (isatty, int, (int fd)); # endif @@ -1120,6 +1225,9 @@ _GL_CXXALIASWARN (isatty); _GL_WARN_ON_USE (isatty, "isatty has portability problems on native Windows - " "use gnulib module isatty for portability"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef isatty +# define isatty _isatty #endif @@ -1231,6 +1339,12 @@ _GL_WARN_ON_USE (linkat, "linkat is unportable - " # endif _GL_FUNCDECL_RPL (lseek, off_t, (int fd, off_t offset, int whence)); _GL_CXXALIAS_RPL (lseek, off_t, (int fd, off_t offset, int whence)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef lseek +# define lseek _lseek +# endif +_GL_CXXALIAS_MDA (lseek, off_t, (int fd, off_t offset, int whence)); # else _GL_CXXALIAS_SYS (lseek, off_t, (int fd, off_t offset, int whence)); # endif @@ -1241,6 +1355,9 @@ _GL_CXXALIASWARN (lseek); _GL_WARN_ON_USE (lseek, "lseek does not fail with ESPIPE on pipes on some " "systems - use gnulib module lseek for portability"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef lseek +# define lseek _lseek #endif @@ -1373,6 +1490,12 @@ _GL_WARN_ON_USE (pwrite, "pwrite is unportable - " _GL_FUNCDECL_RPL (read, ssize_t, (int fd, void *buf, size_t count) _GL_ARG_NONNULL ((2))); _GL_CXXALIAS_RPL (read, ssize_t, (int fd, void *buf, size_t count)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef read +# define read _read +# endif +_GL_CXXALIAS_MDA (read, ssize_t, (int fd, void *buf, size_t count)); # else /* Need to cast, because on mingw, the third parameter is unsigned int count @@ -1380,6 +1503,9 @@ _GL_CXXALIAS_RPL (read, ssize_t, (int fd, void *buf, size_t count)); _GL_CXXALIAS_SYS_CAST (read, ssize_t, (int fd, void *buf, size_t count)); # endif _GL_CXXALIASWARN (read); +#elif defined _WIN32 && !defined __CYGWIN__ +# undef read +# define read _read #endif @@ -1462,6 +1588,12 @@ _GL_WARN_ON_USE (readlinkat, "readlinkat is not portable - " # endif _GL_FUNCDECL_RPL (rmdir, int, (char const *name) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (rmdir, int, (char const *name)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef rmdir +# define rmdir _rmdir +# endif +_GL_CXXALIAS_MDA (rmdir, int, (char const *name)); # else _GL_CXXALIAS_SYS (rmdir, int, (char const *name)); # endif @@ -1472,6 +1604,9 @@ _GL_CXXALIASWARN (rmdir); _GL_WARN_ON_USE (rmdir, "rmdir is unportable - " "use gnulib module rmdir for portability"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef rmdir +# define rmdir _rmdir #endif @@ -1530,6 +1665,12 @@ _GL_WARN_ON_USE (sleep, "sleep is unportable - " #endif +#if defined _WIN32 && !defined __CYGWIN__ +# undef swab +# define swab _swab +#endif + + #if @GNULIB_SYMLINK@ # if @REPLACE_SYMLINK@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) @@ -1654,6 +1795,12 @@ _GL_WARN_ON_USE (ttyname_r, "ttyname_r is not portable - " # endif _GL_FUNCDECL_RPL (unlink, int, (char const *file) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_RPL (unlink, int, (char const *file)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef unlink +# define unlink _unlink +# endif +_GL_CXXALIAS_MDA (unlink, int, (char const *file)); # else _GL_CXXALIAS_SYS (unlink, int, (char const *file)); # endif @@ -1664,6 +1811,9 @@ _GL_CXXALIASWARN (unlink); _GL_WARN_ON_USE (unlink, "unlink is not portable - " "use gnulib module unlink for portability"); # endif +#elif defined _WIN32 && !defined __CYGWIN__ +# undef unlink +# define unlink _unlink #endif @@ -1735,6 +1885,12 @@ _GL_WARN_ON_USE (usleep, "usleep is unportable - " _GL_FUNCDECL_RPL (write, ssize_t, (int fd, const void *buf, size_t count) _GL_ARG_NONNULL ((2))); _GL_CXXALIAS_RPL (write, ssize_t, (int fd, const void *buf, size_t count)); +# elif defined _WIN32 && !defined __CYGWIN__ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef write +# define write _write +# endif +_GL_CXXALIAS_MDA (write, ssize_t, (int fd, const void *buf, size_t count)); # else /* Need to cast, because on mingw, the third parameter is unsigned int count @@ -1742,6 +1898,9 @@ _GL_CXXALIAS_RPL (write, ssize_t, (int fd, const void *buf, size_t count)); _GL_CXXALIAS_SYS_CAST (write, ssize_t, (int fd, const void *buf, size_t count)); # endif _GL_CXXALIASWARN (write); +#elif defined _WIN32 && !defined __CYGWIN__ +# undef write +# define write _write #endif _GL_INLINE_HEADER_END diff --git a/lib/verify.h b/lib/verify.h index f1097612704..d485a0283a9 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -23,11 +23,15 @@ /* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert (R, DIAGNOSTIC) works as per C11. This is supported by GCC 4.6.0 and later, in C - mode. + mode, and by clang (also in C++ mode). Define _GL_HAVE__STATIC_ASSERT1 to 1 if _Static_assert (R) works as - per C2X, and define _GL_HAVE_STATIC_ASSERT1 if static_assert (R) - works as per C++17. This is supported by GCC 9.1 and later. + per C2X. This is supported by GCC 9.1 and later, and by clang in + C++1z mode. + + Define _GL_HAVE_STATIC_ASSERT1 if static_assert (R) works as per + C++17. This is supported by GCC 9.1 and later, and by clang in + C++1z mode. Support compilers claiming conformance to the relevant standard, and also support GCC when not pedantic. If we were willing to slow @@ -35,7 +39,8 @@ since this affects only the quality of diagnostics, why bother? */ #ifndef __cplusplus # if (201112L <= __STDC_VERSION__ \ - || (!defined __STRICT_ANSI__ && 4 < __GNUC__ + (6 <= __GNUC_MINOR__))) + || (!defined __STRICT_ANSI__ \ + && (4 < __GNUC__ + (6 <= __GNUC_MINOR__) || 4 <= __clang_major__))) # define _GL_HAVE__STATIC_ASSERT 1 # endif # if (202000L <= __STDC_VERSION__ \ @@ -43,7 +48,15 @@ # define _GL_HAVE__STATIC_ASSERT1 1 # endif #else -# if 201703L <= __cplusplus || 9 <= __GNUC__ +# if 4 <= __clang_major__ +# define _GL_HAVE__STATIC_ASSERT 1 +# endif +# if 4 <= __clang_major__ && 201411 <= __cpp_static_assert +# define _GL_HAVE__STATIC_ASSERT1 1 +# endif +# if 201703L <= __cplusplus \ + || 9 <= __GNUC__ \ + || (4 <= __clang_major__ && 201411 <= __cpp_static_assert) # define _GL_HAVE_STATIC_ASSERT1 1 # endif #endif @@ -292,7 +305,12 @@ template <int w> Although assuming R can help a compiler generate better code or diagnostics, performance can suffer if R uses hard-to-optimize - features such as function calls not inlined by the compiler. */ + features such as function calls not inlined by the compiler. + + Avoid Clang’s __builtin_assume, as clang 9.0.1 -Wassume can + generate a bogus diagnostic "the argument to '__builtin_assume' has + side effects that will be discarded" even when the argument has no + side effects. */ #if _GL_HAS_BUILTIN_UNREACHABLE # define assume(R) ((R) ? (void) 0 : __builtin_unreachable ()) diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h index 23c10fdd122..3f728d1a9dc 100644 --- a/lib/warn-on-use.h +++ b/lib/warn-on-use.h @@ -87,6 +87,13 @@ extern __typeof__ (function) function __attribute__ ((__warning__ (message))) # define _GL_WARN_ON_USE_ATTRIBUTE(message) \ __attribute__ ((__warning__ (message))) +# elif __clang_major__ >= 4 +/* Another compiler attribute is available in clang. */ +# define _GL_WARN_ON_USE(function, message) \ +extern __typeof__ (function) function \ + __attribute__ ((__diagnose_if__ (1, message, "warning"))) +# define _GL_WARN_ON_USE_ATTRIBUTE(message) \ + __attribute__ ((__diagnose_if__ (1, message, "warning"))) # elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING /* Verify the existence of the function. */ # define _GL_WARN_ON_USE(function, message) \ @@ -99,27 +106,33 @@ _GL_WARN_EXTERN_C int _gl_warn_on_use # endif #endif -/* _GL_WARN_ON_USE_CXX (function, rettype, parameters_and_attributes, "string") - is like _GL_WARN_ON_USE (function, "string"), except that in C++ mode the +/* _GL_WARN_ON_USE_CXX (function, rettype_gcc, rettype_clang, parameters_and_attributes, "message") + is like _GL_WARN_ON_USE (function, "message"), except that in C++ mode the function is declared with the given prototype, consisting of return type, parameters, and attributes. This variant is useful for overloaded functions in C++. _GL_WARN_ON_USE does not work in this case. */ #ifndef _GL_WARN_ON_USE_CXX # if !defined __cplusplus -# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ +# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \ _GL_WARN_ON_USE (function, msg) # else # if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) -# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ -extern rettype function parameters_and_attributes \ - __attribute__ ((__warning__ (msg))) +/* A compiler attribute is available in gcc versions 4.3.0 and later. */ +# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \ +extern rettype_gcc function parameters_and_attributes \ + __attribute__ ((__warning__ (msg))) +# elif __clang_major__ >= 4 +/* Another compiler attribute is available in clang. */ +# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \ +extern rettype_clang function parameters_and_attributes \ + __attribute__ ((__diagnose_if__ (1, msg, "warning"))) # elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING /* Verify the existence of the function. */ -# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ -extern rettype function parameters_and_attributes +# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \ +extern rettype_gcc function parameters_and_attributes # else /* Unsupported. */ -# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ +# define _GL_WARN_ON_USE_CXX(function,rettype_gcc,rettype_clang,parameters_and_attributes,msg) \ _GL_WARN_EXTERN_C int _gl_warn_on_use # endif # endif diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 2d61a96010e..468b0d995b3 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -517,14 +517,6 @@ It is nil if the abbrev has already been unexpanded.") ;; "Local (mode-specific) abbrev table of current buffer.") ;; (make-variable-buffer-local 'local-abbrev-table) -(defcustom pre-abbrev-expand-hook nil - "Function or functions to be called before abbrev expansion is done. -This is the first thing that `expand-abbrev' does, and so this may change -the current abbrev table before abbrev lookup happens." - :type 'hook - :group 'abbrev-mode) -(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-function "23.1") - (defun clear-abbrev-table (table) "Undefine all abbrevs in abbrev table TABLE, leaving it empty." (setq abbrevs-changed t) @@ -836,12 +828,10 @@ Takes no argument and should return the abbrev symbol if expansion took place.") (defun expand-abbrev () "Expand the abbrev before point, if there is an abbrev there. Effective when explicitly called even when `abbrev-mode' is nil. -Before doing anything else, runs `pre-abbrev-expand-hook'. Calls the value of `abbrev-expand-function' with no argument to do the work, and returns whatever it does. (That return value should be the abbrev symbol if expansion occurred, else nil.)" (interactive) - (run-hooks 'pre-abbrev-expand-hook) (funcall abbrev-expand-function)) (defun abbrev--default-expand () diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 2a8dced5e9c..03fc3e2f0e1 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -207,6 +207,7 @@ See `allout-widgets-mode' for allout widgets mode features." :version "24.1" :type 'plist :group 'allout-widgets) +(make-obsolete-variable 'allout-widgets-item-image-properties-xemacs nil "28.1") ;;;_ . Developer ;;;_ = allout-widgets-run-unit-tests-on-load (defcustom allout-widgets-run-unit-tests-on-load nil @@ -323,8 +324,7 @@ In addition, you can invoked `allout-widgets-mode' allout-mode buffers where this is set to enable and disable widget enhancements, directly.") ;;;###autoload -(put 'allout-widgets-mode-inhibit 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp) (make-variable-buffer-local 'allout-widgets-mode-inhibit) ;;;_ = allout-inhibit-body-modification-hook (defvar allout-inhibit-body-modification-hook nil @@ -1510,8 +1510,7 @@ recursive operation." ;; the actual location of the item text: :location 'allout-item-location - :button-keymap allout-item-icon-keymap ; XEmacs - :keymap allout-item-icon-keymap ; Emacs + :keymap allout-item-icon-keymap ;; Element regions: :guides-span nil @@ -2329,15 +2328,13 @@ We use a caching strategy, so the caller doesn't need to do so." (allout-widgets-copy-list (cadr got)) (while (and types (not got)) (setq got - (allout-find-image + (find-image (list (append (list :type (car types) :file (concat use-dir (symbol-name name) "." (symbol-name (car types)))) - (if (featurep 'xemacs) - allout-widgets-item-image-properties-xemacs - allout-widgets-item-image-properties-emacs) + allout-widgets-item-image-properties-emacs )))) (setq types (cdr types))) (if got @@ -2358,11 +2355,7 @@ We use a caching strategy, so the caller doesn't need to do so." 'frame-property) (t nil))) ;;;_ > allout-find-image (specs) -(defalias 'allout-find-image - (if (fboundp 'find-image) - 'find-image - nil) ; aka, not-yet-implemented for xemacs. -) +(define-obsolete-function-alias 'allout-find-image #'find-image "28.1") ;;;_ > allout-widgets-copy-list (list) (defun allout-widgets-copy-list (list) ;; duplicated from cl.el 'copy-list' as of 2008-08-17 diff --git a/lisp/allout.el b/lisp/allout.el index dedad45f827..05d9153a31d 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -410,8 +410,7 @@ where auto-fill occurs." :group 'allout) (make-variable-buffer-local 'allout-use-hanging-indents) ;;;###autoload -(put 'allout-use-hanging-indents 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp) ;;;_ = allout-reindent-bodies (defcustom allout-reindent-bodies (if allout-use-hanging-indents 'text) @@ -440,8 +439,7 @@ just the header." :group 'allout) (make-variable-buffer-local 'allout-show-bodies) ;;;###autoload -(put 'allout-show-bodies 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-show-bodies 'safe-local-variable 'booleanp) ;;;_ = allout-beginning-of-line-cycles (defcustom allout-beginning-of-line-cycles t @@ -662,8 +660,7 @@ are always respected by the topic maneuvering functions." :group 'allout) (make-variable-buffer-local 'allout-old-style-prefixes) ;;;###autoload -(put 'allout-old-style-prefixes 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp) ;;;_ = allout-stylish-prefixes -- alternating bullets (defcustom allout-stylish-prefixes t "Do fancy stuff with topic prefix bullets according to level, etc. @@ -711,8 +708,7 @@ is non-nil." :group 'allout) (make-variable-buffer-local 'allout-stylish-prefixes) ;;;###autoload -(put 'allout-stylish-prefixes 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp) ;;;_ = allout-numbered-bullet (defcustom allout-numbered-bullet "#" @@ -726,10 +722,7 @@ disables numbering maintenance." :group 'allout) (make-variable-buffer-local 'allout-numbered-bullet) ;;;###autoload -(put 'allout-numbered-bullet 'safe-local-variable - (if (fboundp 'string-or-null-p) - 'string-or-null-p - (lambda (x) (or (stringp x) (null x))))) +(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p) ;;;_ = allout-file-xref-bullet (defcustom allout-file-xref-bullet "@" "Bullet signifying file cross-references, for `allout-resolve-xref'. @@ -738,10 +731,7 @@ Set this var to the bullet you want to use for file cross-references." :type '(choice (const nil) string) :group 'allout) ;;;###autoload -(put 'allout-file-xref-bullet 'safe-local-variable - (if (fboundp 'string-or-null-p) - 'string-or-null-p - (lambda (x) (or (stringp x) (null x))))) +(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p) ;;;_ = allout-presentation-padding (defcustom allout-presentation-padding 2 "Presentation-format white-space padding factor, for greater indent." @@ -2484,20 +2474,16 @@ Outermost is first." (allout-back-to-current-heading) (allout-end-of-current-line)) (t - (if (not (allout-mark-active-p)) + (if (not mark-active) (push-mark)) (allout-end-of-entry)))))) + ;;;_ > allout-mark-active-p () (defun allout-mark-active-p () "True if the mark is currently or always active." - ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler - ;; provisions, at least in GNU Emacs to prevent warnings about lack of, - ;; eg, region-active-p. - (cond ((boundp 'mark-active) - mark-active) - ((fboundp 'region-active-p) - (region-active-p)) - (t))) + (declare (obsolete nil "28.1")) + mark-active) + ;;;_ > allout-next-heading () (defsubst allout-next-heading () "Move to the heading for the topic (possibly invisible) after this one. @@ -5452,11 +5438,9 @@ header and body. The elements of that list are: (cdr format))))))) ;; Put the list with first at front, to last at back: (nreverse result)))) -;;;_ > allout-region-active-p () -(defmacro allout-region-active-p () - (cond ((fboundp 'use-region-p) '(use-region-p)) - ((fboundp 'region-active-p) '(region-active-p)) - (t 'mark-active))) + +(define-obsolete-function-alias 'allout-region-active-p 'region-active-p "28.1") + ;;_ > allout-process-exposed (&optional func from to frombuf ;;; tobuf format) (defun allout-process-exposed (&optional func from to frombuf tobuf @@ -5489,7 +5473,7 @@ Defaults: ; defaulting if necessary: (if (not func) (setq func 'allout-insert-listified)) (if (not (and from to)) - (if (allout-region-active-p) + (if (region-active-p) (setq from (region-beginning) to (region-end)) (setq from (point-min) to (point-max)))) (if frombuf diff --git a/lisp/apropos.el b/lisp/apropos.el index 2566d44dfcf..6d8c7847b02 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -543,6 +543,20 @@ will be buffer-local when set." (and (local-variable-if-set-p symbol) (get symbol 'variable-documentation))))) +;;;###autoload +(defun apropos-function (pattern) + "Show functions that match PATTERN. + +PATTERN can be a word, a list of words (separated by spaces), +or a regexp (using some regexp special characters). If it is a word, +search for matches for that word as a substring. If it is a list of words, +search for matches for any two (or more) of those words. + +This is the same as running `apropos-command' with a \\[universal-argument] prefix, +or a non-nil `apropos-do-all' argument." + (interactive (list (apropos-read-pattern "function"))) + (apropos-command pattern t)) + ;; For auld lang syne: ;;;###autoload (defalias 'command-apropos 'apropos-command) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 901f09302ef..ae85fc55add 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -391,6 +391,7 @@ file. Archive and member name will be added." (define-key map "e" 'archive-extract) (define-key map "f" 'archive-extract) (define-key map "\C-m" 'archive-extract) + (define-key map "C" 'archive-copy-file) (define-key map "m" 'archive-mark) (define-key map "n" 'archive-next-line) (define-key map "\C-n" 'archive-next-line) @@ -430,6 +431,9 @@ file. Archive and member name will be added." (define-key map [menu-bar immediate view] '(menu-item "View This File" archive-view :help "Display file at cursor in View Mode")) + (define-key map [menu-bar immediate view] + '(menu-item "Copy This File" archive-copy-file + :help "Copy file at cursor to another location")) (define-key map [menu-bar immediate display] '(menu-item "Display in Other Window" archive-display-other-window :help "Display file at cursor in another window")) @@ -1036,6 +1040,28 @@ return nil. Otherwise point is returned." (archive-goto-file short)) next)) +(defun archive-copy-file (file new-name) + "Copy FILE to a location specified by NEW-NAME. +Interactively, FILE is the file at point, and the function prompts +for NEW-NAME." + (interactive + (let ((name (archive--file-desc-ext-file-name (archive-get-descr)))) + (list name + (read-file-name (format "Copy %s to: " name))))) + (when (file-directory-p new-name) + (setq new-name (expand-file-name file new-name))) + (when (and (file-exists-p new-name) + (not (yes-or-no-p (format "%s already exists; overwrite? " + new-name)))) + (user-error "Not overwriting %s" new-name)) + (let* ((descr (archive-get-descr)) + (archive (buffer-file-name)) + (extractor (archive-name "extract")) + (ename (archive--file-desc-ext-file-name descr))) + (with-temp-buffer + (archive--extract-file extractor archive ename) + (write-region (point-min) (point-max) new-name)))) + (defun archive-extract (&optional other-window-p event) "In archive mode, extract this entry of the archive into its own buffer." (interactive (list nil last-input-event)) @@ -1077,26 +1103,7 @@ return nil. Otherwise point is returned." (setq archive-subfile-mode descr) (setq archive-file-name-coding-system file-name-coding) (if (and - (null - (let (;; We may have to encode the file name argument for - ;; external programs. - (coding-system-for-write - (and enable-multibyte-characters - archive-file-name-coding-system)) - ;; We read an archive member by no-conversion at - ;; first, then decode appropriately by calling - ;; archive-set-buffer-as-visiting-file later. - (coding-system-for-read 'no-conversion) - ;; Avoid changing dir mtime by lock_file - (create-lockfiles nil)) - (condition-case err - (if (fboundp extractor) - (funcall extractor archive ename) - (archive-*-extract archive ename - (symbol-value extractor))) - (error - (ding (message "%s" (error-message-string err))) - nil)))) + (null (archive--extract-file extractor archive ename)) just-created) (progn (set-buffer-modified-p nil) @@ -1129,6 +1136,27 @@ return nil. Otherwise point is returned." (other-window-p (switch-to-buffer-other-window buffer)) (t (switch-to-buffer buffer)))))) +(defun archive--extract-file (extractor archive ename) + (let (;; We may have to encode the file name argument for + ;; external programs. + (coding-system-for-write + (and enable-multibyte-characters + archive-file-name-coding-system)) + ;; We read an archive member by no-conversion at + ;; first, then decode appropriately by calling + ;; archive-set-buffer-as-visiting-file later. + (coding-system-for-read 'no-conversion) + ;; Avoid changing dir mtime by lock_file + (create-lockfiles nil)) + (condition-case err + (if (fboundp extractor) + (funcall extractor archive ename) + (archive-*-extract archive ename + (symbol-value extractor))) + (error + (ding (message "%s" (error-message-string err))) + nil)))) + (defun archive-*-extract (archive name command) (let* ((default-directory (file-name-as-directory archive-tmpdir)) (tmpfile (expand-file-name (file-name-nondirectory name) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index de7d60f97eb..8a3bcf8e59d 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -200,6 +200,7 @@ A non-nil value may result in truncated bookmark names." (define-key map "f" 'bookmark-insert-location) ;"f"ind (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) + (define-key map "D" 'bookmark-delete-all) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) @@ -922,8 +923,6 @@ annotations." "# Date: " (current-time-string) "\n")) -(define-obsolete-variable-alias 'bookmark-read-annotation-text-func - 'bookmark-edit-annotation-text-func "23.1") (defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text "Function to return default text to use for a bookmark annotation. It takes one argument, the name of the bookmark, as a string.") @@ -1142,17 +1141,6 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'." (let ((pop-up-frames t)) (bookmark-jump-other-window bookmark))) -(defun bookmark-jump-noselect (bookmark) - "Return the location pointed to by BOOKMARK (see `bookmark-jump'). -The return value has the form (BUFFER . POINT). - -Note: this function is deprecated and is present for Emacs 22 -compatibility only." - (declare (obsolete bookmark-handle-bookmark "23.1")) - (save-excursion - (bookmark-handle-bookmark bookmark) - (cons (current-buffer) (point)))) - (defun bookmark-handle-bookmark (bookmark-name-or-record) "Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler' if it has none. This changes current buffer and point and returns nil, @@ -1374,6 +1362,23 @@ probably because we were called from there." (bookmark-save))) +;;;###autoload +(defun bookmark-delete-all (&optional no-confirm) + "Permanently delete all bookmarks. +If optional argument NO-CONFIRM is non-nil, don't ask for +confirmation." + (interactive "P") + (when (or no-confirm + (yes-or-no-p "Permanently delete all bookmarks? ")) + (bookmark-maybe-load-default-file) + (setq bookmark-alist-modification-count + (+ bookmark-alist-modification-count (length bookmark-alist))) + (setq bookmark-alist nil) + (bookmark-bmenu-surreptitiously-rebuild-list) + (when (bookmark-time-to-save-p) + (bookmark-save)))) + + (defun bookmark-time-to-save-p (&optional final-time) "Return t if it is time to save bookmarks to disk, nil otherwise. Optional argument FINAL-TIME means this is being called when Emacs @@ -1600,12 +1605,15 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." (define-key map "\C-d" 'bookmark-bmenu-delete-backwards) (define-key map "x" 'bookmark-bmenu-execute-deletions) (define-key map "d" 'bookmark-bmenu-delete) + (define-key map "D" 'bookmark-bmenu-delete-all) (define-key map " " 'next-line) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) (define-key map "\177" 'bookmark-bmenu-backup-unmark) (define-key map "u" 'bookmark-bmenu-unmark) + (define-key map "U" 'bookmark-bmenu-unmark-all) (define-key map "m" 'bookmark-bmenu-mark) + (define-key map "M" 'bookmark-bmenu-mark-all) (define-key map "l" 'bookmark-bmenu-load) (define-key map "r" 'bookmark-bmenu-rename) (define-key map "R" 'bookmark-bmenu-relocate) @@ -1627,8 +1635,10 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." ["Select Marked Bookmarks" bookmark-bmenu-select t] "---" ["Mark Bookmark" bookmark-bmenu-mark t] + ["Mark all Bookmarks" bookmark-bmenu-mark-all t] ["Unmark Bookmark" bookmark-bmenu-unmark t] ["Unmark Backwards" bookmark-bmenu-backup-unmark t] + ["Unmark all Bookmarks" bookmark-bmenu-unmark-all t] ["Toggle Display of Filenames" bookmark-bmenu-toggle-filenames t] ["Display Location of Bookmark" bookmark-bmenu-locate t] "---" @@ -1636,6 +1646,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc." ["Rename Bookmark" bookmark-bmenu-rename t] ["Relocate Bookmark's File" bookmark-bmenu-relocate t] ["Mark Bookmark for Deletion" bookmark-bmenu-delete t] + ["Mark all Bookmarks for Deletion" bookmark-bmenu-delete-all t] ["Delete Marked Bookmarks" bookmark-bmenu-execute-deletions t]) ("Annotations" ["Show Annotation for Current Bookmark" bookmark-bmenu-show-annotation t] @@ -1667,6 +1678,19 @@ Don't affect the buffer ring order." ;;;###autoload +(defun bookmark-bmenu-get-buffer () + "Return the Bookmark List, building it if it doesn't exists. +Don't affect the buffer ring order." + (or (get-buffer bookmark-bmenu-buffer) + (save-excursion + (save-window-excursion + (bookmark-bmenu-list) + (get-buffer bookmark-bmenu-buffer))))) + +(custom-add-choice 'tab-bar-new-tab-choice + '(const :tag "Bookmark List" bookmark-bmenu-get-buffer)) + +;;;###autoload (defun bookmark-bmenu-list () "Display a list of existing bookmarks. The list is displayed in a buffer named `*Bookmark List*'. @@ -1748,6 +1772,7 @@ Letters do not insert themselves; instead, they are commands. Bookmark names preceded by a \"*\" have annotations. \\<bookmark-bmenu-mode-map> \\[bookmark-bmenu-mark] -- mark bookmark to be displayed. +\\[bookmark-bmenu-mark-all] -- mark all listed bookmarks to be displayed. \\[bookmark-bmenu-select] -- select bookmark of line point is on. Also show bookmarks marked using m in other windows. \\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names). @@ -1764,13 +1789,15 @@ Bookmark names preceded by a \"*\" have annotations. \\[bookmark-bmenu-relocate] -- relocate this bookmark's file (prompts for new file). \\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down. \\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up. -\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'. +\\[bookmark-bmenu-delete-all] -- mark all listed bookmarks as to be deleted. +\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]' or `\\[bookmark-bmenu-delete-all]'. \\[bookmark-bmenu-save] -- save the current bookmark list in the default file. With a prefix arg, prompts for a file to save in. \\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.) \\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line. With prefix argument, also move up one line. \\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks. +\\[bookmark-bmenu-unmark-all] -- remove all kinds of marks from all listed bookmarks. \\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark in another buffer. \\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. @@ -1937,9 +1964,23 @@ If the annotation does not exist, do nothing." (bookmark-bmenu-ensure-position)))) +(defun bookmark-bmenu-mark-all () + "Mark all listed bookmarks to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]." + (interactive) + (save-excursion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (with-buffer-modified-unmodified + (let ((inhibit-read-only t)) + (while (not (eobp)) + (delete-char 1) + (insert ?>) + (forward-line 1)))))) + + (defun bookmark-bmenu-select () "Select this line's bookmark; also display bookmarks marked with `>'. -You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command." +You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] or \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark-all] commands." (interactive) (let ((bmrk (bookmark-bmenu-bookmark)) (menu (current-buffer)) @@ -2108,6 +2149,20 @@ Optional BACKUP means move up." (bookmark-bmenu-ensure-position)) +(defun bookmark-bmenu-unmark-all () + "Cancel all requested operations on all listed bookmarks." + (interactive) + (save-excursion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (with-buffer-modified-unmodified + (let ((inhibit-read-only t)) + (while (not (eobp)) + (delete-char 1) + (insert " ") + (forward-line 1)))))) + + (defun bookmark-bmenu-delete () "Mark bookmark on this line to be deleted. To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]." @@ -2133,6 +2188,22 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\ (bookmark-bmenu-ensure-position)) +(defun bookmark-bmenu-delete-all () + "Mark all listed bookmarks as to be deleted. +To remove all deletion marks, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-unmark-all]. +To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]." + (interactive) + (save-excursion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (with-buffer-modified-unmodified + (let ((inhibit-read-only t)) + (while (not (eobp)) + (delete-char 1) + (insert ?D) + (forward-line 1)))))) + + (defun bookmark-bmenu-execute-deletions () "Delete bookmarks flagged `D'." (interactive) @@ -2292,6 +2363,9 @@ strings returned are not." (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) + (bindings--define-key map [delete-all] + '(menu-item "Delete all Bookmarks..." bookmark-delete-all + :help "Delete all bookmarks from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 655a76a713c..d06ba287879 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -69,11 +69,26 @@ minus `Buffer-menu-size-width'. This use is deprecated." "use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead." "24.3") -(defcustom Buffer-menu-name-width 19 - "Width of buffer name column in the Buffer Menu." - :type 'number +(defun Buffer-menu--dynamic-name-width (buffers) + "Return a name column width based on the current window width. +The width will never exceed the actual width of the buffer names, +but will never be narrower than 19 characters." + (max 19 + ;; This gives 19 on an 80 column window, and take up + ;; proportionally more space as the window widens. + (min (truncate (/ (window-width) 4.2)) + (apply #'max 0 (mapcar (lambda (b) + (length (buffer-name b))) + buffers))))) + +(defcustom Buffer-menu-name-width #'Buffer-menu--dynamic-name-width + "Width of buffer name column in the Buffer Menu. +This can either be a number (used directly) or a function that +will be called with the list of buffers and should return a +number." + :type '(choice function number) :group 'Buffer-menu - :version "24.3") + :version "28.1") (defcustom Buffer-menu-size-width 7 "Width of buffer size column in the Buffer Menu." @@ -214,9 +229,6 @@ commands.") map) "Local keymap for `Buffer-menu-mode' buffers.") -(define-obsolete-variable-alias 'buffer-menu-mode-hook - 'Buffer-menu-mode-hook "23.1") - (define-derived-mode Buffer-menu-mode tabulated-list-mode "Buffer Menu" "Major mode for Buffer Menu buffers. The Buffer Menu is invoked by the commands \\[list-buffers], @@ -488,8 +500,9 @@ Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted (defun Buffer-menu-select () "Select this line's buffer; also, display buffers marked with `>'. You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command. + This command deletes and replaces all the previously existing windows -in the selected frame." +in the selected frame, and will remove any marks." (interactive) (let* ((this-buffer (Buffer-menu-buffer t)) (menu-buffer (current-buffer)) @@ -645,25 +658,11 @@ means list those buffers and no others." (defun list-buffers--refresh (&optional buffer-list old-buffer) ;; Set up `tabulated-list-format'. - (let ((name-width Buffer-menu-name-width) - (size-width Buffer-menu-size-width) + (let ((size-width Buffer-menu-size-width) (marked-buffers (Buffer-menu-marked-buffers)) (buffer-menu-buffer (current-buffer)) (show-non-file (not Buffer-menu-files-only)) - entries) - ;; Handle obsolete variable: - (if Buffer-menu-buffer+size-width - (setq name-width (- Buffer-menu-buffer+size-width size-width))) - (setq tabulated-list-format - (vector '("C" 1 t :pad-right 0) - '("R" 1 t :pad-right 0) - '("M" 1 t) - `("Buffer" ,name-width t) - `("Size" ,size-width tabulated-list-entry-size-> - :right-align t) - `("Mode" ,Buffer-menu-mode-width t) - '("File" 1 t))) - (setq tabulated-list-use-header-line Buffer-menu-use-header-line) + entries name-width) ;; Collect info for each buffer we're interested in. (dolist (buffer (or buffer-list (buffer-list (if Buffer-menu-use-frame-buffer-list @@ -693,6 +692,22 @@ means list those buffers and no others." nil nil buffer))) (Buffer-menu--pretty-file-name file))) entries))))) + (setq name-width (if (functionp Buffer-menu-name-width) + (funcall Buffer-menu-name-width (mapcar #'car entries)) + Buffer-menu-name-width)) + ;; Handle obsolete variable: + (if Buffer-menu-buffer+size-width + (setq name-width (- Buffer-menu-buffer+size-width size-width))) + (setq tabulated-list-format + (vector '("C" 1 t :pad-right 0) + '("R" 1 t :pad-right 0) + '("M" 1 t) + `("Buffer" ,name-width t) + `("Size" ,size-width tabulated-list-entry-size-> + :right-align t) + `("Mode" ,Buffer-menu-mode-width t) + '("File" 1 t))) + (setq tabulated-list-use-header-line Buffer-menu-use-header-line) (setq tabulated-list-entries (nreverse entries))) (tabulated-list-init-header)) diff --git a/lisp/button.el b/lisp/button.el index d9c36a0375c..03ab59b109c 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -464,8 +464,12 @@ see). POS defaults to point, except when `push-button' is invoked interactively as the result of a mouse-event, in which case, the mouse event is used. + If there's no button at POS, do nothing and return nil, otherwise -return t." +return t. + +To get a description of what function will called when pushing a +butting, use the `button-describe' command." (interactive (list (if (integerp last-command-event) (point) last-command-event))) (if (and (not (integerp pos)) (eventp pos)) @@ -555,6 +559,51 @@ Returns the button found." (interactive "p\nd\nd") (forward-button (- n) wrap display-message no-error)) +(defun button--describe (properties) + "Describe a button's PROPERTIES (an alist) in a *Help* buffer. +This is a helper function for `button-describe', in order to be possible to +use `help-setup-xref'. + +Each element of PROPERTIES should be of the form (PROPERTY . VALUE)." + (help-setup-xref (list #'button--describe properties) + (called-interactively-p 'interactive)) + (with-help-window (help-buffer) + (with-current-buffer (help-buffer) + (insert (format-message "This button's type is `%s'." + (alist-get 'type properties))) + (dolist (prop '(action mouse-action)) + (let ((name (symbol-name prop)) + (val (alist-get prop properties))) + (when (functionp val) + (insert "\n\n" + (propertize (capitalize name) 'face 'bold) + "\nThe " name " of this button is") + (if (symbolp val) + (progn + (insert (format-message " `%s',\nwhich is " val)) + (describe-function-1 val)) + (insert "\n") + (princ val)))))))) + +(defun button-describe (&optional button-or-pos) + "Display a buffer with information about the button at point. + +When called from Lisp, pass BUTTON-OR-POS as the button to describe, or a +buffer position where a button is present. If BUTTON-OR-POS is nil, the +button at point is the button to describe." + (interactive "d") + (let* ((button (cond ((integer-or-marker-p button-or-pos) + (button-at button-or-pos)) + ((null button-or-pos) (button-at (point))) + ((overlayp button-or-pos) button-or-pos))) + (props (and button + (mapcar (lambda (prop) + (cons prop (button-get button prop))) + '(type action mouse-action))))) + (when props + (button--describe props) + t))) + (provide 'button) ;;; button.el ends here diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index f5150ca552c..690aaf2687f 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -150,34 +150,16 @@ ;; otherwise it just parses the yanked string. ;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96 ;;;###autoload -(defun calc-yank (radix) - "Yank a value into the Calculator buffer. - -Valid numeric prefixes for RADIX: 0, 2, 6, 8 -No radix notation is prepended for any other numeric prefix. - -If RADIX is 2, prepend \"2#\" - Binary. -If RADIX is 8, prepend \"8#\" - Octal. -If RADIX is 0, prepend \"10#\" - Decimal. -If RADIX is 6, prepend \"16#\" - Hexadecimal. +(defun calc-yank-internal (radix thing-raw) + "Internal common implementation for yank functions. -If RADIX is a non-nil list (created using \\[universal-argument]), the user -will be prompted to enter the radix in the minibuffer. - -If RADIX is nil or if the yanked string already has a calc radix prefix, the -yanked string will be passed on directly to the Calculator buffer without any -alteration." - (interactive "P") +This function is used by both `calc-yank' and `calc-yank-mouse-primary'." (calc-wrapper (calc-pop-push-record-list 0 "yank" (let* (radix-num radix-notation valid-num-regexp - (thing-raw - (if (fboundp 'current-kill) - (current-kill 0 t) - (car kill-ring-yank-pointer))) (thing (if (or (null radix) ;; Match examples: -2#10, 10\n(10#10,01) @@ -232,6 +214,38 @@ alteration." val)) val)))))))) +;;;###autoload +(defun calc-yank-mouse-primary (radix) + "Yank the current primary selection into the Calculator buffer. +See `calc-yank' for details about RADIX." + (interactive "P") + (if (or select-enable-primary + select-enable-clipboard) + (calc-yank-internal radix (gui-get-primary-selection)) + ;; Yank from the kill ring. + (calc-yank radix))) + +;;;###autoload +(defun calc-yank (radix) + "Yank a value into the Calculator buffer. + +Valid numeric prefixes for RADIX: 0, 2, 6, 8 +No radix notation is prepended for any other numeric prefix. + +If RADIX is 2, prepend \"2#\" - Binary. +If RADIX is 8, prepend \"8#\" - Octal. +If RADIX is 0, prepend \"10#\" - Decimal. +If RADIX is 6, prepend \"16#\" - Hexadecimal. + +If RADIX is a non-nil list (created using \\[universal-argument]), the user +will be prompted to enter the radix in the minibuffer. + +If RADIX is nil or if the yanked string already has a calc radix prefix, the +yanked string will be passed on directly to the Calculator buffer without any +alteration." + (interactive "P") + (calc-yank-internal radix (current-kill 0 t))) + ;;; The Calc set- and get-register commands are modified versions of functions ;;; in register.el diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 09b49621070..fb1287baaa6 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1087,8 +1087,26 @@ Used by `calc-user-invocation'.") (append (where-is-internal 'delete-backward-char global-map) (where-is-internal 'backward-delete-char global-map) (where-is-internal 'backward-delete-char-untabify global-map) - '("\C-d")) - '("\177" "\C-d"))) + '("\177")) + '("\177"))) + +(mapc (lambda (x) + (ignore-errors + (define-key calc-digit-map x 'calcDigit-delchar) + (define-key calc-mode-map x 'calc-pop) + (define-key calc-mode-map + (if (and (vectorp x) (featurep 'xemacs)) + (if (= (length x) 1) + (vector (if (consp (aref x 0)) + (cons 'meta (aref x 0)) + (list 'meta (aref x 0)))) + "\e\C-d") + (vconcat "\e" x)) + 'calc-pop-above))) + (if calc-scan-for-dels + (append (where-is-internal 'delete-forward-char global-map) + '("\C-d")) + '("\C-d"))) (defvar calc-dispatch-map (let ((map (make-keymap))) @@ -2343,7 +2361,6 @@ the United States." (defun calcDigit-key () (interactive) - (goto-char (point-max)) (if (or (and (memq last-command-event '(?+ ?-)) (> (buffer-size) 0) (/= (preceding-char) ?e)) @@ -2386,8 +2403,7 @@ the United States." (delete-char 1)) (if (looking-at "-") (delete-char 1) - (insert "-"))) - (goto-char (point-max))) + (insert "-")))) ((eq last-command-event ?p) (if (or (calc-minibuffer-contains ".*\\+/-.*") (calc-minibuffer-contains ".*mod.*") @@ -2440,17 +2456,9 @@ the United States." (setq calc-prev-prev-char calc-prev-char calc-prev-char last-command-event)) - (defun calcDigit-backspace () (interactive) - (goto-char (point-max)) - (cond ((calc-minibuffer-contains ".* \\+/- \\'") - (backward-delete-char 5)) - ((calc-minibuffer-contains ".* mod \\'") - (backward-delete-char 5)) - ((calc-minibuffer-contains ".* \\'") - (backward-delete-char 2)) - ((eq last-command 'calcDigit-start) + (cond ((eq last-command 'calcDigit-start) (erase-buffer)) (t (backward-delete-char 1))) (if (= (calc-minibuffer-size) 0) @@ -2925,6 +2933,20 @@ the United States." (- (- (nth 2 a) (nth 2 b)) ldiff)))) +(defun calcDigit-delchar () + (interactive) + (cond ((looking-at-p " \\+/- \\'") + (delete-char 5)) + ((looking-at-p " mod \\'") + (delete-char 5)) + ((looking-at-p " \\'") + (delete-char 2)) + ((eq last-command 'calcDigit-start) + (erase-buffer)) + (t (unless (eobp) (delete-char 1)))) + (when (= (calc-minibuffer-size) 0) + (setq last-command-event 13) + (calcDigit-nondigit))) (defvar math-comp-selected) diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 3db12e668ab..05768e10c01 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -350,17 +350,31 @@ If the locale never uses daylight saving time, set this to 0." :group 'calendar-dst) (defcustom calendar-standard-time-zone-name - (or (nth 2 calendar-current-time-zone-cache) "EST") + (if (eq calendar-time-zone-style 'numeric) + (if calendar-current-time-zone-cache + (format-time-string + "%z" 0 (* 60 (car calendar-current-time-zone-cache))) + "+0000") + (or (nth 2 calendar-current-time-zone-cache) "EST")) "Abbreviated name of standard time zone at `calendar-location-name'. For example, \"EST\" in New York City, \"PST\" for Los Angeles." :type 'string + :version "28.1" + :set-after '(calendar-time-zone-style) :group 'calendar-dst) (defcustom calendar-daylight-time-zone-name - (or (nth 3 calendar-current-time-zone-cache) "EDT") + (if (eq calendar-time-zone-style 'numeric) + (if calendar-current-time-zone-cache + (format-time-string + "%z" 0 (* 60 (cadr calendar-current-time-zone-cache))) + "+0000") + (or (nth 3 calendar-current-time-zone-cache) "EDT")) "Abbreviated name of daylight saving time zone at `calendar-location-name'. For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." :type 'string + :version "28.1" + :set-after '(calendar-time-zone-style) :group 'calendar-dst) (defcustom calendar-daylight-savings-starts-time diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 1d5b9479e2b..574261456fc 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1061,6 +1061,15 @@ calendar." :type 'boolean :group 'holidays) +;; fixme should have a :set that changes calendar-standard-time-zone-name etc. +(defcustom calendar-time-zone-style 'symbolic + "Your preferred style for time zones. +If 'numeric, use numeric time zones like \"+0100\". +Otherwise, use symbolic time zones like \"CET\"." + :type '(choice (const numeric) (other symbolic)) + :version "28.1" + :group 'calendar) + ;;; End of user options. (calendar-recompute-layout-variables) diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 6a813e9ee82..05bb3164e12 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -209,7 +209,6 @@ Returns nil if nothing was entered." (defun solar-setup () "Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'." - (beep) (or calendar-longitude (setq calendar-longitude (solar-get-number @@ -840,7 +839,9 @@ This function is suitable for execution in an init file." "E" "W")))))) (calendar-standard-time-zone-name (if (< arg 16) calendar-standard-time-zone-name - (cond ((zerop calendar-time-zone) "UTC") + (cond ((zerop calendar-time-zone) + (if (eq calendar-time-zone-style 'numeric) + "+0000" "UTC")) ((< calendar-time-zone 0) (format "UTC%dmin" calendar-time-zone)) (t (format "UTC+%dmin" calendar-time-zone))))) @@ -1013,7 +1014,10 @@ Requires floating point." (let* ((m displayed-month) (y displayed-year) (calendar-standard-time-zone-name - (if calendar-time-zone calendar-standard-time-zone-name "UTC")) + (cond + (calendar-time-zone calendar-standard-time-zone-name) + ((eq calendar-time-zone-style 'numeric) "+0000") + (t "UTC"))) (calendar-daylight-savings-starts (if calendar-time-zone calendar-daylight-savings-starts)) (calendar-daylight-savings-ends diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el index ecce3e7105b..140e7387a68 100644 --- a/lisp/cedet/ede/make.el +++ b/lisp/cedet/ede/make.el @@ -32,29 +32,15 @@ (declare-function inversion-check-version "inversion") -(if (fboundp 'locate-file) - (defsubst ede--find-executable (exec) - "Return an expanded file name for a program EXEC on the exec path." - (locate-file exec exec-path)) - - ;; Else, older version of Emacs. - - (defsubst ede--find-executable (exec) - "Return an expanded file name for a program EXEC on the exec path." - (let ((p exec-path) - (found nil)) - (while (and p (not found)) - (let ((f (expand-file-name exec (car p)))) - (if (file-exists-p f) - (setq found f))) - (setq p (cdr p))) - found)) - ) +(defsubst ede--find-executable (exec) + "Return an expanded file name for a program EXEC on the exec path." + (declare (obsolete locate-file "28.1")) + (locate-file exec exec-path)) (defvar ede-make-min-version "3.0" "Minimum version of GNU make required.") -(defcustom ede-make-command (cond ((ede--find-executable "gmake") +(defcustom ede-make-command (cond ((executable-find "gmake") "gmake") (t "make")) ;; What to do? "The MAKE command to use for EDE when compiling. diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 358829a4568..3649d1c2f1f 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -46,27 +46,10 @@ (declare-function c-forward-conditional "cc-cmds") (declare-function ede-system-include-path "ede") -;;; Compatibility -;; (eval-when-compile (require 'cc-mode)) -(if (fboundp 'c-end-of-macro) - (eval-and-compile - (defalias 'semantic-c-end-of-macro 'c-end-of-macro)) - ;; From cc-mode 5.30 - (defun semantic-c-end-of-macro () - "Go to the end of a preprocessor directive. -More accurately, move point to the end of the closest following line -that doesn't end with a line continuation backslash. - -This function does not do any hidden buffer changes." - (while (progn - (end-of-line) - (when (and (eq (char-before) ?\\) - (not (eobp))) - (forward-char) - t)))) - ) +(define-obsolete-function-alias 'semantic-c-end-of-macro + #'c-end-of-macro "28.1") ;;; Code: (with-suppressed-warnings ((obsolete define-child-mode)) @@ -266,7 +249,7 @@ Return the defined symbol as a special spp lex token." (semantic-lex-analyzer #'semantic-cpp-lexer) (raw-stream (semantic-lex-spp-stream-for-macro (save-excursion - (semantic-c-end-of-macro) + (c-end-of-macro) ;; HACK - If there's a C comment after ;; the macro, do not parse it. (if (looking-back "/\\*.*" beginning-of-define) @@ -590,7 +573,7 @@ case, we must skip it since it is the ELSE part." (define-lex-regex-analyzer semantic-lex-c-macrobits "Ignore various forms of #if/#else/#endif conditionals." "^\\s-*#\\s-*\\(if\\(n?def\\)?\\|endif\\|elif\\|else\\)" - (semantic-c-end-of-macro) + (c-end-of-macro) (setq semantic-lex-end-point (point)) nil) diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el index 47afa25dd74..60ab6033aec 100644 --- a/lisp/cedet/semantic/dep.el +++ b/lisp/cedet/semantic/dep.el @@ -183,16 +183,8 @@ macro `defcustom-mode-local-semantic-dependency-system-include-path'." ;; ;; methods for finding files on a provided path. (defmacro semantic--dependency-find-file-on-path (file path) - (if (fboundp 'locate-file) - `(locate-file ,file ,path) - `(let ((p ,path) - (found nil)) - (while (and p (not found)) - (let ((f (expand-file-name ,file (car p)))) - (if (file-exists-p f) - (setq found f))) - (setq p (cdr p))) - found))) + (declare (obsolete locate-file "28.1")) + `(locate-file ,file ,path)) (defvar ede-minor-mode) (defvar ede-object) @@ -216,11 +208,11 @@ provided mode, not from the current major mode." (when (file-exists-p file) (setq found file)) (when (and (not found) (not systemp)) - (setq found (semantic--dependency-find-file-on-path file locp))) + (setq found (locate-file file locp))) (when (and (not found) edesys) - (setq found (semantic--dependency-find-file-on-path file edesys))) + (setq found (locate-file file edesys))) (when (not found) - (setq found (semantic--dependency-find-file-on-path file sysp))) + (setq found (locate-file file sysp))) (if found (expand-file-name found)))) diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 7a1273d6534..e347c99f191 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -68,13 +68,11 @@ ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to ;; run major mode hooks. -(defalias 'semantic-run-mode-hooks - (if (fboundp 'run-mode-hooks) - 'run-mode-hooks - 'run-hooks)) +(define-obsolete-function-alias 'semantic-run-mode-hooks 'run-mode-hooks "28.1") - ;; Fancy compat usage now handled in cedet-compat -(defalias 'semantic-subst-char-in-string 'subst-char-in-string) +;; Fancy compat usage now handled in cedet-compat +(define-obsolete-function-alias 'semantic-subst-char-in-string + 'subst-char-in-string "28.1") (defun semantic-delete-overlay-maybe (overlay) "Delete OVERLAY if it is a semantic token overlay." diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 1ed18339a72..6cd4832165c 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1251,6 +1251,7 @@ common grammar menu." "Setup an XEmacs grammar menu in variable SYMBOL. MODE-MENU is an optional specific menu whose items are appended to the common grammar menu." + (declare (obsolete nil "28.1")) (let ((items (make-symbol "items")) (path (make-symbol "path"))) `(progn diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index b8812de05b6..e6e124eb812 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -70,7 +70,7 @@ (require 'semantic) (require 'semantic/lex) -(declare-function semantic-c-end-of-macro "semantic/bovine/c") +(declare-function c-end-of-macro "cc-engine") ;;; Code: (defvar semantic-lex-spp-macro-symbol-obarray nil @@ -946,7 +946,7 @@ by another macro." (save-excursion (let ((start (match-beginning 0)) (end (match-end 0)) - (peom (save-excursion (semantic-c-end-of-macro) (point)))) + (peom (save-excursion (c-end-of-macro) (point)))) (condition-case nil (progn ;; This will throw an error if no closing paren can be found. diff --git a/lisp/comint.el b/lisp/comint.el index 4b3b5838560..092902d865e 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -223,6 +223,13 @@ This variable is buffer-local." (other :tag "on" t)) :group 'comint) +(defcustom comint-highlight-input t + "If non-nil, highlight input with `comint-highlight-input' face. +Otherwise keep the original highlighting untouched." + :version "28.1" + :type 'boolean + :group 'comint) + (defface comint-highlight-input '((t (:weight bold))) "Face to use to highlight user input." :group 'comint) @@ -249,6 +256,10 @@ to set this in a mode hook, rather than customize the default value." file) :group 'comint) +(defvar comint-input-ring-file-prefix nil + "The prefix to skip when parsing the input ring file. +This is useful in Zsh when the extended_history option is on.") + (defcustom comint-scroll-to-bottom-on-input nil "Controls whether input to interpreter causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. @@ -731,7 +742,7 @@ contents are sent to the process as its initial input. If PROGRAM is a string, any more args are arguments to PROGRAM. Return the (possibly newly created) process buffer." - (or (fboundp 'start-file-process) + (or (fboundp 'make-process) (error "Multi-processing is not supported for this system")) (setq buffer (get-buffer-create (or buffer (concat "*" name "*")))) ;; If no process, or nuked process, crank up a new one and put buffer in @@ -987,8 +998,20 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'." (setq end (match-beginning 0))) (setq start (if (re-search-backward ring-separator nil t) - (match-end 0) - (point-min))) + (progn + (when (and comint-input-ring-file-prefix + (looking-at + comint-input-ring-file-prefix)) + ;; Skip zsh extended_history stamps + (goto-char (match-end 0))) + (match-end 0)) + (progn + (goto-char (point-min)) + (when (and comint-input-ring-file-prefix + (looking-at + comint-input-ring-file-prefix)) + (goto-char (match-end 0))) + (point)))) (setq history (buffer-substring start end)) (goto-char start) (when (and (not (string-match history-ignore history)) @@ -1881,9 +1904,10 @@ Similarly for Soar, Scheme, etc." (end (if no-newline (point) (1- (point))))) (with-silent-modifications (when (> end beg) - (add-text-properties beg end - '(front-sticky t - font-lock-face comint-highlight-input)) + (when comint-highlight-input + (add-text-properties beg end + '( font-lock-face comint-highlight-input + front-sticky t ))) (unless comint-use-prompt-regexp ;; Give old user input a field property of `input', to ;; distinguish it from both process output and unsent @@ -3836,7 +3860,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." (set-buffer output-buffer) (goto-char (point-min)) ;; Skip past the command, if it was echoed - (and (looking-at command) + (and (looking-at (regexp-quote command)) (forward-line)) (while (and (not (eobp)) (re-search-forward regexp nil t)) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 1942f25e891..23ceb3a857a 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -801,16 +801,19 @@ has been executed, nil otherwise." If a setting was edited and set before, this saves it. If a setting was merely edited before, this sets it then saves it." (interactive) - (when (custom-command-apply - (lambda (child) - (when (memq (widget-get child :custom-state) - '(modified set changed rogue)) - (widget-apply child :custom-mark-to-save))) - "Save all settings in this buffer? " t) - ;; Save changes to buffer and redraw. - (custom-save-all) - (dolist (child custom-options) - (widget-apply child :custom-state-set-and-redraw)))) + (let (edited-widgets) + (when (custom-command-apply + (lambda (child) + (when (memq (widget-get child :custom-state) + '(modified set changed rogue)) + (push child edited-widgets) + (widget-apply child :custom-mark-to-save))) + "Save all settings in this buffer? " t) + ;; Save changes to buffer. + (custom-save-all) + ;; Redraw and recalculate the state when necessary. + (dolist (widget edited-widgets) + (widget-apply widget :custom-state-set-and-redraw))))) (defun custom-reset (_widget &optional event) "Select item from reset menu." @@ -4841,7 +4844,10 @@ The format is suitable for use with `easy-menu-define'." (error "You can't edit this part of the Custom buffer")) (defun Custom-newline (pos &optional event) - "Invoke button at POS, or refuse to allow editing of Custom buffer." + "Invoke button at POS, or refuse to allow editing of Custom buffer. + +To see what function the widget will call, use the +`widget-describe' command." (interactive "@d") (let ((button (get-char-property pos 'button))) ;; If there is no button at point, then use the one at the start @@ -4865,8 +4871,6 @@ If several parents are listed, go to the first of them." (parent (downcase (widget-get button :tag)))) (customize-group parent))))) -(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1") - (defcustom Custom-mode-hook nil "Hook called when entering Custom mode." :type 'hook @@ -4937,8 +4941,6 @@ if that value is non-nil." (put 'Custom-mode 'mode-class 'special) -(define-obsolete-function-alias 'custom-mode 'Custom-mode "23.1") - ;;; The End. (provide 'cus-edit) diff --git a/lisp/custom.el b/lisp/custom.el index 885c486c5e4..db7f6a056d4 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1541,6 +1541,20 @@ Each of the arguments ARGS has this form: This means reset VARIABLE. (The argument IGNORED is ignored)." (apply #'custom-theme-reset-variables 'user args)) +(defun custom-add-choice (variable choice) + "Add CHOICE to the custom type of VARIABLE. +If a choice with the same tag already exists, no action is taken." + (let ((choices (get variable 'custom-type))) + (unless (eq (car choices) 'choice) + (error "Not a choice type: %s" choices)) + (unless (seq-find (lambda (elem) + (equal (caddr (member :tag elem)) + (caddr (member :tag choice)))) + (cdr choices)) + ;; Put the new choice at the end. + (put variable 'custom-type + (append choices (list choice)))))) + ;;; The End. (provide 'custom) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 55f0b7dcb40..d6da4280630 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -141,8 +141,7 @@ otherwise." (wid-field (get-char-property pos 'field)) (wid-button (get-char-property pos 'button)) (wid-doc (get-char-property pos 'widget-doc)) - ;; If button.el is not loaded, we have no buttons in the text. - (button (and (fboundp 'button-at) (button-at pos))) + (button (button-at pos)) (button-type (and button (button-type button))) (button-label (and button (button-label button))) (widget (or wid-field wid-button wid-doc))) diff --git a/lisp/desktop.el b/lisp/desktop.el index 7fe5f73b879..7a7f1d07c93 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1037,7 +1037,7 @@ file. To upgrade a version 206 file to version 208, call this command explicitly with a prefix argument: \\[universal-argument] \\[desktop-save]. -If you are upgrading from Emacs 24 or older, we recommed to do +If you are upgrading from Emacs 24 or older, we recommend to do this once you decide you no longer need compatibility with versions of Emacs before 25.1. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 6587d039b72..c197ed04fe2 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -688,7 +688,7 @@ are executed in the background on each file sequentially waiting for each command to terminate before running the next command. In shell syntax this means separating the individual commands with `;'. -The output appears in the buffer `*Async Shell Command*'." +The output appears in the buffer named by `shell-command-buffer-name-async'." (interactive (let ((files (dired-get-marked-files t current-prefix-arg nil nil t))) (list @@ -726,16 +726,16 @@ it, write `*\"\"' in place of just `*'. This is equivalent to just `*' in the shell, but avoids Dired's special handling. If COMMAND ends in `&', `;', or `;&', it is executed in the -background asynchronously, and the output appears in the buffer -`*Async Shell Command*'. When operating on multiple files and COMMAND -ends in `&', the shell command is executed on each file in parallel. -However, when COMMAND ends in `;' or `;&' then commands are executed -in the background on each file sequentially waiting for each command -to terminate before running the next command. You can also use -`dired-do-async-shell-command' that automatically adds `&'. +background asynchronously, and the output appears in the buffer named +by `shell-command-buffer-name-async'. When operating on multiple files +and COMMAND ends in `&', the shell command is executed on each file +in parallel. However, when COMMAND ends in `;' or `;&', then commands +are executed in the background on each file sequentially waiting for +each command to terminate before running the next command. You can +also use `dired-do-async-shell-command' that automatically adds `&'. Otherwise, COMMAND is executed synchronously, and the output -appears in the buffer `*Shell Command Output*'. +appears in the buffer named by `shell-command-buffer-name'. This feature does not try to redisplay Dired buffers afterward, as there's no telling what files COMMAND may have changed. @@ -1604,7 +1604,7 @@ Special value `always' suppresses confirmation." (defun dired-copy-file (from to ok-flag) (dired-handle-overwrite to) (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t - dired-recursive-copies)) + dired-recursive-copies dired-copy-dereference)) (declare-function make-symbolic-link "fileio.c") @@ -1627,7 +1627,8 @@ If `ask', ask for user confirmation." (dired-create-directory dir)))) (defun dired-copy-file-recursive (from to ok-flag &optional - preserve-time top recursive) + preserve-time top recursive + dereference) (when (and (eq t (file-attribute-type (file-attributes from))) (file-in-directory-p to from)) (error "Cannot copy `%s' into its subdirectory `%s'" from to)) @@ -1639,7 +1640,8 @@ If `ask', ask for user confirmation." (copy-directory from to preserve-time) (or top (dired-handle-overwrite to)) (condition-case err - (if (stringp (file-attribute-type attrs)) + (if (and (not dereference) + (stringp (file-attribute-type attrs))) ;; It is a symlink (make-symbolic-link (file-attribute-type attrs) to ok-flag) (dired-maybe-create-dirs (file-name-directory to)) @@ -2165,6 +2167,9 @@ See HOW-TO argument for `dired-do-create-files'.") ;;;###autoload (defun dired-do-copy (&optional arg) "Copy all marked (or next ARG) files, or copy the current file. +ARG has to be numeric for above functionality. See +`dired-get-marked-files' for more details. + When operating on just the current file, prompt for the new name. When operating on multiple or marked files, prompt for a target @@ -2178,10 +2183,18 @@ If `dired-copy-preserve-time' is non-nil, this command preserves the modification time of each old file in the copy, similar to the \"-p\" option for the \"cp\" shell command. -This command copies symbolic links by creating new ones, similar -to the \"-d\" option for the \"cp\" shell command." +This command copies symbolic links by creating new ones, +similar to the \"-d\" option for the \"cp\" shell command. +But if `dired-copy-dereference' is non-nil, the symbolic +links are dereferenced and then copied, similar to the \"-L\" +option for the \"cp\" shell command. If ARG is a cons with +element 4 (`\\[universal-argument]'), the inverted value of +`dired-copy-dereference' will be used." (interactive "P") - (let ((dired-recursive-copies dired-recursive-copies)) + (let ((dired-recursive-copies dired-recursive-copies) + (dired-copy-dereference (if (equal arg '(4)) + (not dired-copy-dereference) + dired-copy-dereference))) (dired-do-create-files 'copy #'dired-copy-file "Copy" arg dired-keep-marker-copy diff --git a/lisp/dired.el b/lisp/dired.el index d19d6d1581d..77bb6cfa9ca 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -216,6 +216,12 @@ The target is used in the prompt for file copy, rename etc." :type 'boolean :group 'dired) +(defcustom dired-copy-dereference nil + "If non-nil, Dired dereferences symlinks when copying them. +This is similar to the \"-L\" option for the \"cp\" shell command." + :type 'boolean + :group 'dired) + ; ; These variables were deleted and the replacements are on files.el. ; We leave aliases behind for back-compatibility. (define-obsolete-variable-alias 'dired-free-space-program diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 3a0bbd2c9c2..ad0c18d1b38 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -196,9 +196,6 @@ directory." (remove-hook 'comint-preoutput-filter-functions 'dirtrack t))) -(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode - "23.1") -(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1") (define-minor-mode dirtrack-debug-mode "Toggle Dirtrack debugging." nil nil nil diff --git a/lisp/doc-view.el b/lisp/doc-view.el index de342f1519e..77c06a8eaf9 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -435,6 +435,9 @@ Typically \"page-%s.png\".") (define-key map (kbd "c m") 'doc-view-set-slice-using-mouse) (define-key map (kbd "c b") 'doc-view-set-slice-from-bounding-box) (define-key map (kbd "c r") 'doc-view-reset-slice) + ;; Centering the image + (define-key map (kbd "c h") 'doc-view-center-page-horizontally) + (define-key map (kbd "c v") 'doc-view-center-page-vertically) ;; Searching (define-key map (kbd "C-s") 'doc-view-search) (define-key map (kbd "<find>") 'doc-view-search) @@ -740,8 +743,7 @@ It's a subdirectory of `doc-view-cache-directory'." Document types are symbols like `dvi', `ps', `pdf', or `odf' (any OpenDocument format)." (and (display-graphic-p) - (or (image-type-available-p 'imagemagick) - (image-type-available-p 'png)) + (image-type-available-p 'png) (cond ((eq type 'dvi) (and (doc-view-mode-p 'pdf) @@ -769,10 +771,7 @@ OpenDocument format)." (defun doc-view-enlarge (factor) "Enlarge the document by FACTOR." (interactive (list doc-view-shrink-factor)) - (if (and doc-view-scale-internally - (eq (plist-get (cdr (doc-view-current-image)) :type) - 'imagemagick)) - ;; ImageMagick supports on-the-fly-rescaling. + (if doc-view-scale-internally (let ((new (ceiling (* factor doc-view-image-width)))) (unless (equal new doc-view-image-width) (setq-local doc-view-image-width new) @@ -792,9 +791,7 @@ OpenDocument format)." (defun doc-view-scale-reset () "Reset the document size/zoom level to the initial one." (interactive) - (if (and doc-view-scale-internally - (eq (plist-get (cdr (doc-view-current-image)) :type) - 'imagemagick)) + (if doc-view-scale-internally (progn (kill-local-variable 'doc-view-image-width) (doc-view-insert-image @@ -927,6 +924,32 @@ Resize the containing frame if needed." (when new-frame-params (modify-frame-parameters (selected-frame) new-frame-params)))) +(defun doc-view-center-page-horizontally () + "Center page horizontally when page is wider than window." + (interactive) + (let ((page-width (car (image-size (doc-view-current-image) 'pixel))) + (window-width (window-body-width nil 'pixel)) + ;; How much do we scroll in order to center the page? + (pixel-hscroll 0) + ;; How many pixels are there in a column? + (col-in-pixel (/ (window-body-width nil 'pixel) + (window-body-width nil)))) + (when (> page-width window-width) + (setq pixel-hscroll (/ (- page-width window-width) 2)) + (set-window-hscroll (selected-window) + (/ pixel-hscroll col-in-pixel))))) + +(defun doc-view-center-page-vertically () + "Center page vertically when page is wider than window." + (interactive) + (let ((page-height (cdr (image-size (doc-view-current-image) 'pixel))) + (window-height (window-body-height nil 'pixel)) + ;; How much do we scroll in order to center the page? + (pixel-scroll 0)) + (when (> page-height window-height) + (setq pixel-scroll (/ (- page-height window-height) 2)) + (set-window-vscroll (selected-window) pixel-scroll 'pixel)))) + (defun doc-view-reconvert-doc () "Reconvert the current document. Should be invoked when the cached images aren't up-to-date." @@ -1393,12 +1416,11 @@ ARGS is a list of image descriptors." ;; Only insert the image if the buffer is visible. (when (window-live-p (overlay-get ol 'window)) (let* ((image (if (and file (file-readable-p file)) - (if (not (and doc-view-scale-internally - (fboundp 'imagemagick-types))) + (if (not doc-view-scale-internally) (apply #'create-image file doc-view--image-type nil args) (unless (member :width args) (setq args `(,@args :width ,doc-view-image-width))) - (apply #'create-image file 'imagemagick nil args)))) + (apply #'create-image file doc-view--image-type nil args)))) (slice (doc-view-current-slice)) (img-width (and image (car (image-size image)))) (displayed-img-width (if (and image slice) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index c76de43be91..2eef4512009 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -1,4 +1,4 @@ -;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*- +;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*- ;; Copyright (C) 1991-1997, 2001-2020 Free Software Foundation, Inc. @@ -604,9 +604,8 @@ Don't try to split prefixes that are already longer than that.") prefix file dropped) nil)))) prefixes))) - `(if (fboundp 'register-definition-prefixes) - (register-definition-prefixes ,file ',(sort (delq nil strings) - 'string<))))))) + `(register-definition-prefixes ,file ',(sort (delq nil strings) + 'string<)))))) (defun autoload--setup-output (otherbuf outbuf absfile load-name) (let ((outbuf diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0d9c449b3b4..4987596bf95 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -648,14 +648,23 @@ (setq args (cons (car rest) args))) (setq rest (cdr rest))) (if (cdr constants) - (if args - (list (car form) - (apply (car form) constants) - (if (cdr args) - (cons (car form) (nreverse args)) - (car args))) - (apply (car form) constants)) - form))) + (let ((const (apply (car form) (nreverse constants)))) + (if args + (append (list (car form) const) + (nreverse args)) + const)) + form))) + +(defun byte-optimize-min-max (form) + "Optimize `min' and `max'." + (let ((opt (byte-optimize-associative-math form))) + (if (and (consp opt) (memq (car opt) '(min max)) + (= (length opt) 4)) + ;; (OP x y z) -> (OP (OP x y) z), in order to use binary byte ops. + (list (car opt) + (list (car opt) (nth 1 opt) (nth 2 opt)) + (nth 3 opt)) + opt))) ;; Use OP to reduce any leading prefix of constant numbers in the list ;; (cons ACCUM ARGS) down to a single number, and return the @@ -878,8 +887,8 @@ (put '* 'byte-optimizer #'byte-optimize-multiply) (put '- 'byte-optimizer #'byte-optimize-minus) (put '/ 'byte-optimizer #'byte-optimize-divide) -(put 'max 'byte-optimizer #'byte-optimize-associative-math) -(put 'min 'byte-optimizer #'byte-optimize-associative-math) +(put 'max 'byte-optimizer #'byte-optimize-min-max) +(put 'min 'byte-optimizer #'byte-optimize-min-max) (put '= 'byte-optimizer #'byte-optimize-binary-predicate) (put 'eq 'byte-optimizer #'byte-optimize-binary-predicate) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 22e648e44ba..7ae8749ab40 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3580,10 +3580,10 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler (% byte-rem) 2) (byte-defop-compiler aset 3) -(byte-defop-compiler max byte-compile-associative) -(byte-defop-compiler min byte-compile-associative) -(byte-defop-compiler (+ byte-plus) byte-compile-associative) -(byte-defop-compiler (* byte-mult) byte-compile-associative) +(byte-defop-compiler max byte-compile-min-max) +(byte-defop-compiler min byte-compile-min-max) +(byte-defop-compiler (+ byte-plus) byte-compile-variadic-numeric) +(byte-defop-compiler (* byte-mult) byte-compile-variadic-numeric) ;;####(byte-defop-compiler move-to-column 1) (byte-defop-compiler-1 interactive byte-compile-noop) @@ -3730,30 +3730,36 @@ discarding." (if byte-compile--for-effect (setq byte-compile--for-effect nil) (byte-compile-out 'byte-constant (nth 1 form)))) -;; Compile a function that accepts one or more args and is right-associative. -;; We do it by left-associativity so that the operations -;; are done in the same order as in interpreted code. -;; We treat the one-arg case, as in (+ x), like (+ x 0). -;; in order to convert markers to numbers, and trigger expected errors. -(defun byte-compile-associative (form) +;; Compile a pure function that accepts zero or more numeric arguments +;; and has an opcode for the binary case. +;; Single-argument calls are assumed to be numeric identity and are +;; compiled as (* x 1) in order to convert markers to numbers and +;; trigger type errors. +(defun byte-compile-variadic-numeric (form) + (pcase (length form) + (1 + ;; No args: use the identity value for the operation. + (byte-compile-constant (eval form))) + (2 + ;; One arg: compile (OP x) as (* x 1). This is identity for + ;; all numerical values including -0.0, infinities and NaNs. + (byte-compile-form (nth 1 form)) + (byte-compile-constant 1) + (byte-compile-out (get '* 'byte-opcode) 0)) + (3 + (byte-compile-form (nth 1 form)) + (byte-compile-form (nth 2 form)) + (byte-compile-out (get (car form) 'byte-opcode) 0)) + (_ + ;; >2 args: compile as a single function call. + (byte-compile-normal-call form)))) + +(defun byte-compile-min-max (form) + "Byte-compile calls to `min' or `max'." (if (cdr form) - (let ((opcode (get (car form) 'byte-opcode)) - args) - (if (and (< 3 (length form)) - (memq opcode (list (get '+ 'byte-opcode) - (get '* 'byte-opcode)))) - ;; Don't use binary operations for > 2 operands, as that - ;; may cause overflow/truncation in float operations. - (byte-compile-normal-call form) - (setq args (copy-sequence (cdr form))) - (byte-compile-form (car args)) - (setq args (cdr args)) - (or args (setq args '(0) - opcode (get '+ 'byte-opcode))) - (dolist (arg args) - (byte-compile-form arg) - (byte-compile-out opcode 0)))) - (byte-compile-constant (eval form)))) + (byte-compile-variadic-numeric form) + ;; No args: warn and emit code that raises an error when executed. + (byte-compile-normal-call form))) ;; more complicated compiler macros @@ -3768,7 +3774,7 @@ discarding." (byte-defop-compiler indent-to) (byte-defop-compiler insert) (byte-defop-compiler-1 function byte-compile-function-form) -(byte-defop-compiler-1 - byte-compile-minus) +(byte-defop-compiler (- byte-diff) byte-compile-minus) (byte-defop-compiler (/ byte-quo) byte-compile-quo) (byte-defop-compiler nconc) @@ -3835,30 +3841,17 @@ discarding." ((byte-compile-normal-call form))))) (defun byte-compile-minus (form) - (let ((len (length form))) - (cond - ((= 1 len) (byte-compile-constant 0)) - ((= 2 len) - (byte-compile-form (cadr form)) - (byte-compile-out 'byte-negate 0)) - ((= 3 len) - (byte-compile-form (nth 1 form)) - (byte-compile-form (nth 2 form)) - (byte-compile-out 'byte-diff 0)) - ;; Don't use binary operations for > 2 operands, as that may - ;; cause overflow/truncation in float operations. - (t (byte-compile-normal-call form))))) + (if (/= (length form) 2) + (byte-compile-variadic-numeric form) + (byte-compile-form (cadr form)) + (byte-compile-out 'byte-negate 0))) (defun byte-compile-quo (form) - (let ((len (length form))) - (cond ((< len 2) - (byte-compile-subr-wrong-args form "1 or more")) - ((= len 3) - (byte-compile-two-args form)) - (t - ;; Don't use binary operations for > 2 operands, as that - ;; may cause overflow/truncation in float operations. - (byte-compile-normal-call form))))) + (if (= (length form) 3) + (byte-compile-two-args form) + ;; N-ary `/' is not the left-reduction of binary `/' because if any + ;; argument is a float, then everything is done in floating-point. + (byte-compile-normal-call form))) (defun byte-compile-nconc (form) (let ((len (length form))) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 2321ac1ed50..964836a32ac 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -105,9 +105,7 @@ Useful if new Emacs is used on B&W display.") (car cl) "white")) (set-face-foreground nf "black") - (if (and chart-face-use-pixmaps - pl - (fboundp 'set-face-background-pixmap)) + (if (and chart-face-use-pixmaps pl) (condition-case nil (set-face-background-pixmap nf (car pl)) (error (message "Cannot set background pixmap %s" (car pl))))) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index e4b800786cc..1029b52220d 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1249,13 +1249,8 @@ checking of documentation strings. ;;; Subst utils ;; -(defsubst checkdoc-run-hooks (hookvar &rest args) - "Run hooks in HOOKVAR with ARGS." - (if (fboundp 'run-hook-with-args-until-success) - (apply #'run-hook-with-args-until-success hookvar args) - ;; This method was similar to above. We ignore the warning - ;; since we will use the above for future Emacs versions - (apply #'run-hook-with-args hookvar args))) +(define-obsolete-function-alias 'checkdoc-run-hooks + #'run-hook-with-args-until-success "28.1") (defsubst checkdoc-create-common-verbs-regexp () "Rebuild the contents of `checkdoc-common-verbs-regexp'." @@ -1873,7 +1868,7 @@ Replace with \"%s\"? " original replace) ;; and reliance on the Ispell program. (checkdoc-ispell-docstring-engine e take-notes) ;; User supplied checks - (save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e)) + (save-excursion (run-hook-with-args-until-success 'checkdoc-style-functions fp e)) ;; Done! ))) @@ -2384,7 +2379,7 @@ Code:, and others referenced in the style guide." err (or ;; Generic Full-file checks (should be comment related) - (checkdoc-run-hooks 'checkdoc-comment-style-functions) + (run-hook-with-args-until-success 'checkdoc-comment-style-functions) err)) ;; Done with full file comment checks err))) diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 65483d0813a..89d106ee489 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -270,12 +270,6 @@ with empty strings removed." (remove-hook 'choose-completion-string-functions 'crm--choose-completion-string))) -(define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1") -(define-obsolete-function-alias - 'crm-minibuffer-completion-help 'crm-completion-help "23.1") -(define-obsolete-function-alias - 'crm-minibuffer-complete-and-exit 'crm-complete-and-exit "23.1") - ;; testing and debugging ;; (defun crm-init-test-environ () ;; "Set up some variables for testing." diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 3eafad177dd..6a11f1c3949 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -364,6 +364,7 @@ which more-or-less shadow%s %s's corresponding table%s." (defsubst derived-mode-setup-function-name (mode) "Construct a setup-function name based on a MODE name." + (declare (obsolete nil "28.1")) (intern (concat (symbol-name mode) "-setup"))) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 6ba8b997f84..73dabef3fa5 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -29,16 +29,6 @@ ;;; Code: -(defvar easy-menu-precalculate-equivalent-keybindings nil - "Determine when equivalent key bindings are computed for easy-menu menus. -It can take some time to calculate the equivalent key bindings that are shown -in a menu. If the variable is on, then this calculation gives a (maybe -noticeable) delay when a mode is first entered. If the variable is off, then -this delay will come when a menu is displayed the first time. If you never use -menus, turn this variable off, otherwise it is probably better to keep it on.") -(make-obsolete-variable - 'easy-menu-precalculate-equivalent-keybindings nil "23.1") - (defsubst easy-menu-intern (s) (if (stringp s) (intern s) s)) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 19b3bd78aea..4825b5c5e6c 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -289,13 +289,13 @@ Otherwise work like `message'." (or (window-in-direction 'above (minibuffer-window)) (minibuffer-selected-window) (get-largest-window))) - (when mode-line-format - (unless (and (listp mode-line-format) - (assq 'eldoc-mode-line-string mode-line-format)) + (when (and mode-line-format + (not (and (listp mode-line-format) + (assq 'eldoc-mode-line-string mode-line-format)))) (setq mode-line-format (list "" '(eldoc-mode-line-string (" " eldoc-mode-line-string " ")) - mode-line-format)))) + mode-line-format))) (setq eldoc-mode-line-string (when (stringp format-string) (apply #'format-message format-string args))) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 764354b03b7..241eece05b6 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -515,7 +515,14 @@ Returns nil if they are." `(cdr ,cdr-x) (cl-assert (equal a b) t) nil)))))))) - ((pred arrayp) + ((pred cl-struct-p) + (cl-loop for slot in (cl-struct-slot-info (type-of a)) + for ai across a + for bi across b + for xf = (ert--explain-equal-rec ai bi) + do (when xf (cl-return `(struct-field ,(car slot) ,xf))) + finally (cl-assert (equal a b) t))) + ((or (pred arrayp) (pred recordp)) ;; For mixed unibyte/multibyte string comparisons, make both multibyte. (when (and (stringp a) (xor (multibyte-string-p a) (multibyte-string-p b))) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index e35db56550d..56b3e32a3e3 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -292,12 +292,13 @@ if non-nil)." (find-library-suffixes) "\\|")) (table (cl-loop for dir in (or find-function-source-path load-path) - when (file-readable-p dir) + for dir-or-default = (or dir default-directory) + when (file-readable-p dir-or-default) append (mapcar (lambda (file) (replace-regexp-in-string suffix-regexp "" file)) - (directory-files dir nil + (directory-files dir-or-default nil suffix-regexp)))) (def (if (eq (function-called-at-point) 'require) ;; `function-called-at-point' may return 'require diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el new file mode 100644 index 00000000000..8cef029c4cf --- /dev/null +++ b/lisp/emacs-lisp/hierarchy.el @@ -0,0 +1,579 @@ +;;; hierarchy.el --- Library to create and display hierarchy structures -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Damien Cassou <damien@cassou.me> +;; Maintainer: emacs-devel@gnu.org + +;; 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: + +;; Library to create, query, navigate and display hierarchy structures. + +;; Creation: After having created a hierarchy with `hierarchy-new', +;; populate it by calling `hierarchy-add-tree' or +;; `hierarchy-add-trees'. You can then optionally sort its element +;; with `hierarchy-sort'. + +;; Querying: You can learn more about your hierarchy by using +;; functions such as `hierarchy-roots', `hierarchy-has-item', +;; `hierarchy-length', `hierarchy-parent', `hierarchy-descendant-p'. + +;; Navigation: When your hierarchy is ready, you can use +;; `hierarchy-map-item', `hierarchy-map', and `map-tree' to apply +;; functions to elements of the hierarchy. + +;; Display: You can display a hierarchy as a tabulated list using +;; `hierarchy-tabulated-display' and as an expandable/foldable tree +;; using `hierarchy-convert-to-tree-widget'. The +;; `hierarchy-labelfn-*' functions will help you display each item of +;; the hierarchy the way you want it. + +;;; Limitation: + +;; - Current implementation uses #'equal to find and distinguish +;; elements. Support for user-provided equality definition is +;; desired but not yet implemented; +;; +;; - nil can't be added to a hierarchy; +;; +;; - the hierarchy is computed eagerly. + +;;; Code: + +(require 'seq) +(require 'map) +(require 'subr-x) +(require 'cl-lib) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helpers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct (hierarchy + (:constructor hierarchy--make) + (:conc-name hierarchy--)) + (roots (list)) ; list of the hierarchy roots (no parent) + (parents (make-hash-table :test 'equal)) ; map an item to its parent + (children (make-hash-table :test 'equal)) ; map an item to its childre + ;; cache containing the set of all items in the hierarchy + (seen-items (make-hash-table :test 'equal))) ; map an item to t + +(defun hierarchy--seen-items-add (hierarchy item) + "In HIERARCHY, add ITEM to seen items." + (map-put! (hierarchy--seen-items hierarchy) item t)) + +(defun hierarchy--compute-roots (hierarchy) + "Search roots of HIERARCHY and return them." + (cl-set-difference + (map-keys (hierarchy--seen-items hierarchy)) + (map-keys (hierarchy--parents hierarchy)) + :test #'equal)) + +(defun hierarchy--sort-roots (hierarchy sortfn) + "Compute, sort and store the roots of HIERARCHY. + +SORTFN is a function taking two items of the hierarchy as parameter and +returning non-nil if the first parameter is lower than the second." + (setf (hierarchy--roots hierarchy) + (sort (hierarchy--compute-roots hierarchy) + sortfn))) + +(defun hierarchy--add-relation (hierarchy item parent acceptfn) + "In HIERARCHY, add ITEM as child of PARENT. + +ACCEPTFN is a function returning non-nil if its parameter (any object) +should be an item of the hierarchy." + (let* ((existing-parent (hierarchy-parent hierarchy item)) + (has-parent-p (funcall acceptfn existing-parent))) + (cond + ((and has-parent-p (not (equal existing-parent parent))) + (error "An item (%s) can only have one parent: '%s' vs '%s'" + item existing-parent parent)) + ((not has-parent-p) + (let ((existing-children (map-elt (hierarchy--children hierarchy) + parent (list)))) + (map-put! (hierarchy--children hierarchy) + parent (append existing-children (list item)))) + (map-put! (hierarchy--parents hierarchy) item parent))))) + +(defun hierarchy--set-equal (list1 list2 &rest cl-keys) + "Return non-nil if LIST1 and LIST2 have same elements. + +I.e., if every element of LIST1 also appears in LIST2 and if +every element of LIST2 also appears in LIST1. + +CL-KEYS are key-value pairs just like in `cl-subsetp'. Supported +keys are :key and :test." + (and (apply 'cl-subsetp list1 list2 cl-keys) + (apply 'cl-subsetp list2 list1 cl-keys))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Creation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun hierarchy-new () + "Create a hierarchy and return it." + (hierarchy--make)) + +(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn acceptfn) + "In HIERARCHY, add ITEM. + +PARENTFN is either nil or a function defining the child-to-parent +relationship: this function takes an item as parameter and should return +the parent of this item in the hierarchy. If the item has no parent in the +hierarchy (i.e., it should be a root), the function should return an object +not accepted by acceptfn (i.e., nil for the default value of acceptfn). + +CHILDRENFN is either nil or a function defining the parent-to-children +relationship: this function takes an item as parameter and should return a +list of children of this item in the hierarchy. + +If both PARENTFN and CHILDRENFN are non-nil, the results of PARENTFN and +CHILDRENFN are expected to be coherent with each other. + +ACCEPTFN is a function returning non-nil if its parameter (any object) +should be an item of the hierarchy. By default, ACCEPTFN returns non-nil +if its parameter is non-nil." + (unless (hierarchy-has-item hierarchy item) + (let ((acceptfn (or acceptfn #'identity))) + (hierarchy--seen-items-add hierarchy item) + (let ((parent (and parentfn (funcall parentfn item)))) + (when (funcall acceptfn parent) + (hierarchy--add-relation hierarchy item parent acceptfn) + (hierarchy-add-tree hierarchy parent parentfn childrenfn))) + (let ((children (and childrenfn (funcall childrenfn item)))) + (mapc (lambda (child) + (when (funcall acceptfn child) + (hierarchy--add-relation hierarchy child item acceptfn) + (hierarchy-add-tree hierarchy child parentfn childrenfn))) + children))))) + +(defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn acceptfn) + "Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS. + +PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'." + (seq-map (lambda (item) + (hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn)) + items)) + +(defun hierarchy-add-list (hierarchy list &optional wrap childrenfn) + "Add to HIERARCHY the sub-lists in LIST. + +If WRAP is non-nil, allow duplicate items in LIST by wraping each +item in a cons (id . item). The root's id is 1. + +CHILDRENFN is a function (defaults to `cdr') taking LIST as a +parameter which should return LIST's children (a list). Each +child is (recursively) passed as a parameter to CHILDRENFN to get +its own children. Because of this parameter, LIST can be +anything, not necessarily a list." + (let* ((childrenfn (or childrenfn #'cdr)) + (id 0) + (wrapfn (lambda (item) + (if wrap + (cons (setq id (1+ id)) item) + item))) + (unwrapfn (if wrap #'cdr #'identity))) + (hierarchy-add-tree + hierarchy (funcall wrapfn list) nil + (lambda (item) + (mapcar wrapfn (funcall childrenfn + (funcall unwrapfn item))))) + hierarchy)) + +(defun hierarchy-from-list (list &optional wrap childrenfn) + "Create and return a hierarchy built from LIST. + +This function passes LIST, WRAP and CHILDRENFN unchanged to +`hierarchy-add-list'." + (hierarchy-add-list (hierarchy-new) list wrap childrenfn)) + +(defun hierarchy-sort (hierarchy &optional sortfn) + "Modify HIERARCHY so that its roots and item's children are sorted. + +SORTFN is a function taking two items of the hierarchy as parameter and +returning non-nil if the first parameter is lower than the second. By +default, SORTFN is `string-lessp'." + (let ((sortfn (or sortfn #'string-lessp))) + (hierarchy--sort-roots hierarchy sortfn) + (mapc (lambda (parent) + (setf + (map-elt (hierarchy--children hierarchy) parent) + (sort (map-elt (hierarchy--children hierarchy) parent) sortfn))) + (map-keys (hierarchy--children hierarchy))))) + +(defun hierarchy-extract-tree (hierarchy item) + "Return a copy of HIERARCHY with ITEM's descendants and parents." + (if (not (hierarchy-has-item hierarchy item)) + nil + (let ((tree (hierarchy-new))) + (hierarchy-add-tree tree item + (lambda (each) (hierarchy-parent hierarchy each)) + (lambda (each) + (when (or (equal each item) + (hierarchy-descendant-p hierarchy each item)) + (hierarchy-children hierarchy each)))) + tree))) + +(defun hierarchy-copy (hierarchy) + "Return a copy of HIERARCHY. + +Items in HIERARCHY are shared, but structure is not." + (hierarchy-map-hierarchy (lambda (item _) (identity item)) hierarchy)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Querying +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun hierarchy-items (hierarchy) + "Return a list of all items of HIERARCHY." + (map-keys (hierarchy--seen-items hierarchy))) + +(defun hierarchy-has-item (hierarchy item) + "Return t if HIERARCHY includes ITEM." + (map-contains-key (hierarchy--seen-items hierarchy) item)) + +(defun hierarchy-empty-p (hierarchy) + "Return t if HIERARCHY is empty." + (= 0 (hierarchy-length hierarchy))) + +(defun hierarchy-length (hierarchy) + "Return the number of items in HIERARCHY." + (hash-table-count (hierarchy--seen-items hierarchy))) + +(defun hierarchy-has-root (hierarchy item) + "Return t if one of HIERARCHY's roots is ITEM. + +A root is an item with no parent." + (seq-contains-p (hierarchy-roots hierarchy) item)) + +(defun hierarchy-roots (hierarchy) + "Return all roots of HIERARCHY. + +A root is an item with no parent." + (let ((roots (hierarchy--roots hierarchy))) + (or roots + (hierarchy--compute-roots hierarchy)))) + +(defun hierarchy-leafs (hierarchy &optional node) + "Return all leafs of HIERARCHY. + +A leaf is an item with no child. + +If NODE is an item of HIERARCHY, only return leafs under NODE." + (let ((leafs (cl-set-difference + (map-keys (hierarchy--seen-items hierarchy)) + (map-keys (hierarchy--children hierarchy))))) + (if (hierarchy-has-item hierarchy node) + (seq-filter (lambda (item) + (hierarchy-descendant-p hierarchy item node)) + leafs) + leafs))) + +(defun hierarchy-parent (hierarchy item) + "In HIERARCHY, return parent of ITEM." + (map-elt (hierarchy--parents hierarchy) item)) + +(defun hierarchy-children (hierarchy parent) + "In HIERARCHY, return children of PARENT." + (map-elt (hierarchy--children hierarchy) parent (list))) + +(defun hierarchy-child-p (hierarchy item1 item2) + "In HIERARCHY, return non-nil if and only if ITEM1 is a child of ITEM2." + (equal (hierarchy-parent hierarchy item1) item2)) + +(defun hierarchy-descendant-p (hierarchy item1 item2) + "In HIERARCHY, return non-nil if and only if ITEM1 is a descendant of ITEM2. + +ITEM1 is a descendant of ITEM2 if and only if both are items of HIERARCHY +and either: + +- ITEM1 is child of ITEM2, or +- ITEM1's parent is a descendant of ITEM2." + (and + (hierarchy-has-item hierarchy item1) + (hierarchy-has-item hierarchy item2) + (or + (hierarchy-child-p hierarchy item1 item2) + (hierarchy-descendant-p + hierarchy (hierarchy-parent hierarchy item1) item2)))) + +(defun hierarchy-equal (hierarchy1 hierarchy2) + "Return t if HIERARCHY1 and HIERARCHY2 are equal. + +Two equal hierarchies share the same items and the same +relationships among them." + (and (hierarchy-p hierarchy1) + (hierarchy-p hierarchy2) + (= (hierarchy-length hierarchy1) (hierarchy-length hierarchy2)) + ;; parents are the same + (seq-every-p (lambda (child) + (equal (hierarchy-parent hierarchy1 child) + (hierarchy-parent hierarchy2 child))) + (map-keys (hierarchy--parents hierarchy1))) + ;; children are the same + (seq-every-p (lambda (parent) + (hierarchy--set-equal + (hierarchy-children hierarchy1 parent) + (hierarchy-children hierarchy2 parent) + :test #'equal)) + (map-keys (hierarchy--children hierarchy1))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Navigation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun hierarchy-map-item (func item hierarchy &optional indent) + "Return the result of applying FUNC to ITEM and its descendants in HIERARCHY. + +This function navigates the tree top-down: FUNCTION is first called on item +and then on each of its children. Results are concatenated in a list. + +INDENT is a number (default 0) representing the indentation of ITEM in +HIERARCHY. FUNC should take 2 argument: the item and its indentation +level." + (let ((indent (or indent 0))) + (cons + (funcall func item indent) + (seq-mapcat (lambda (child) (hierarchy-map-item func child + hierarchy (1+ indent))) + (hierarchy-children hierarchy item))))) + +(defun hierarchy-map (func hierarchy &optional indent) + "Return the result of applying FUNC to each element of HIERARCHY. + +This function navigates the tree top-down: FUNCTION is first called on each +root. To do so, it calls `hierarchy-map-item' on each root +sequentially. Results are concatenated in a list. + +FUNC should take 2 arguments: the item and its indentation level. + +INDENT is a number (default 0) representing the indentation of HIERARCHY's +roots." + (let ((indent (or indent 0))) + (seq-mapcat (lambda (root) (hierarchy-map-item func root hierarchy indent)) + (hierarchy-roots hierarchy)))) + +(defun hierarchy-map-tree (function hierarchy &optional item indent) + "Apply FUNCTION on each item of HIERARCHY under ITEM. + +This function navigates the tree bottom-up: FUNCTION is first called on +leafs and the result is passed as parameter when calling FUNCTION on +parents. + +FUNCTION should take 3 parameters: the current item, its indentation +level (a number), and a list representing the result of applying +`hierarchy-map-tree' to each child of the item. + +INDENT is 0 by default and is passed as second parameter to FUNCTION. +INDENT is incremented by 1 at each level of the tree. + +This function returns the result of applying FUNCTION to ITEM (the first +root if nil)." + (let ((item (or item (car (hierarchy-roots hierarchy)))) + (indent (or indent 0))) + (funcall function item indent + (mapcar (lambda (child) + (hierarchy-map-tree function hierarchy + child (1+ indent))) + (hierarchy-children hierarchy item))))) + +(defun hierarchy-map-hierarchy (function hierarchy) + "Apply FUNCTION to each item of HIERARCHY in a new hierarchy. + +FUNCTION should take 2 parameters, the current item and its +indentation level (a number), and should return an item to be +added to the new hierarchy." + (let* ((items (make-hash-table :test #'equal)) + (transform (lambda (item) (map-elt items item)))) + ;; Make 'items', a table mapping original items to their + ;; transformation + (hierarchy-map (lambda (item indent) + (map-put! items item (funcall function item indent))) + hierarchy) + (hierarchy--make + :roots (mapcar transform (hierarchy-roots hierarchy)) + :parents (let ((result (make-hash-table :test #'equal))) + (map-apply (lambda (child parent) + (map-put! result + (funcall transform child) + (funcall transform parent))) + (hierarchy--parents hierarchy)) + result) + :children (let ((result (make-hash-table :test #'equal))) + (map-apply (lambda (parent children) + (map-put! result + (funcall transform parent) + (seq-map transform children))) + (hierarchy--children hierarchy)) + result) + :seen-items (let ((result (make-hash-table :test #'equal))) + (map-apply (lambda (item v) + (map-put! result + (funcall transform item) + v)) + (hierarchy--seen-items hierarchy)) + result)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Display +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun hierarchy-labelfn-indent (labelfn &optional indent-string) + "Return a function rendering LABELFN indented with INDENT-STRING. + +INDENT-STRING defaults to a 2-space string. Indentation is +multiplied by the depth of the displayed item." + (let ((indent-string (or indent-string " "))) + (lambda (item indent) + (dotimes (_ indent) (insert indent-string)) + (funcall labelfn item indent)))) + +(defun hierarchy-labelfn-button (labelfn actionfn) + "Return a function rendering LABELFN in a button. + +Clicking the button triggers ACTIONFN. ACTIONFN is a function +taking an item of HIERARCHY and an indentation value (a number) +as input. This function is called when an item is clicked. The +return value of ACTIONFN is ignored." + (lambda (item indent) + (let ((start (point))) + (funcall labelfn item indent) + (make-text-button start (point) + 'action (lambda (_) (funcall actionfn item indent)))))) + +(defun hierarchy-labelfn-button-if (labelfn buttonp actionfn) + "Return a function rendering LABELFN as a button if BUTTONP. + +Pass LABELFN and ACTIONFN to `hierarchy-labelfn-button' if +BUTTONP is non-nil. Otherwise, render LABELFN without making it +a button. + +BUTTONP is a function taking an item of HIERARCHY and an +indentation value (a number) as input." + (lambda (item indent) + (if (funcall buttonp item indent) + (funcall (hierarchy-labelfn-button labelfn actionfn) item indent) + (funcall labelfn item indent)))) + +(defun hierarchy-labelfn-to-string (labelfn item indent) + "Execute LABELFN on ITEM and INDENT. Return result as a string." + (with-temp-buffer + (funcall labelfn item indent) + (buffer-substring (point-min) (point-max)))) + +(defun hierarchy-print (hierarchy &optional to-string) + "Insert HIERARCHY in current buffer as plain text. + +Use TO-STRING to convert each element to a string. TO-STRING is +a function taking an item of HIERARCHY as input and returning a +string. If nil, TO-STRING defaults to a call to `format' with \"%s\"." + (let ((to-string (or to-string (lambda (item) (format "%s" item))))) + (hierarchy-map + (hierarchy-labelfn-indent (lambda (item _) + (insert (funcall to-string item) "\n"))) + hierarchy))) + +(defun hierarchy-to-string (hierarchy &optional to-string) + "Return a string representing HIERARCHY. + +TO-STRING is passed unchanged to `hierarchy-print'." + (with-temp-buffer + (hierarchy-print hierarchy to-string) + (buffer-substring (point-min) (point-max)))) + +(defun hierarchy-tabulated-imenu-action (_item-name position) + "Move to ITEM-NAME at POSITION in current buffer." + (goto-char position) + (back-to-indentation)) + +(define-derived-mode hierarchy-tabulated-mode tabulated-list-mode "Hierarchy tabulated" + "Major mode to display a hierarchy as a tabulated list." + (setq-local imenu-generic-expression + ;; debbugs: 26457 - Cannot pass a function to + ;; imenu-generic-expression. Add + ;; `hierarchy-tabulated-imenu-action' to the end of the + ;; list when bug is fixed + '(("Item" "^[[:space:]]+\\(?1:.+\\)$" 1)))) + +(defun hierarchy-tabulated-display (hierarchy labelfn &optional buffer) + "Display HIERARCHY as a tabulated list in `hierarchy-tabulated-mode'. + +LABELFN is a function taking an item of HIERARCHY and an indentation +level (a number) as input and inserting a string to be displayed in the +table. + +The tabulated list is displayed in BUFFER, or a newly created buffer if +nil. The buffer is returned." + (let ((buffer (or buffer (generate-new-buffer "hierarchy-tabulated")))) + (with-current-buffer buffer + (hierarchy-tabulated-mode) + (setq tabulated-list-format + (vector '("Item name" 0 nil))) + (setq tabulated-list-entries + (hierarchy-map (lambda (item indent) + (list item (vector (hierarchy-labelfn-to-string + labelfn item indent)))) + hierarchy)) + (tabulated-list-init-header) + (tabulated-list-print)) + buffer)) + +(declare-function widget-convert "wid-edit") +(defun hierarchy-convert-to-tree-widget (hierarchy labelfn) + "Return a tree-widget for HIERARCHY. + +LABELFN is a function taking an item of HIERARCHY and an indentation +value (a number) as parameter and inserting a string to be displayed as a +node label." + (require 'wid-edit) + (require 'tree-widget) + (hierarchy-map-tree (lambda (item indent children) + (widget-convert + 'tree-widget + :tag (hierarchy-labelfn-to-string labelfn item indent) + :args children)) + hierarchy)) + +(defun hierarchy-tree-display (hierarchy labelfn &optional buffer) + "Display HIERARCHY as a tree widget in a new buffer. + +HIERARCHY and LABELFN are passed unchanged to +`hierarchy-convert-to-tree-widget'. + +The tree widget is displayed in BUFFER, or a newly created buffer if +nil. The buffer is returned." + (let ((buffer (or buffer (generate-new-buffer "*hierarchy-tree*"))) + (tree-widget (hierarchy-convert-to-tree-widget hierarchy labelfn))) + (with-current-buffer buffer + (setq-local buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (widget-create tree-widget) + (goto-char (point-min)) + (special-mode))) + buffer)) + +(provide 'hierarchy) + +;;; hierarchy.el ends here diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1311d94cb01..584ed8c6f90 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -200,7 +200,9 @@ (save-excursion (ignore-errors (goto-char pos) - (or (eql (char-before) ?\') + ;; '(lambda ..) is not a funcall position, but #'(lambda ...) is. + (or (and (eql (char-before) ?\') + (not (eql (char-before (1- (point))) ?#))) (let* ((ppss (syntax-ppss)) (paren-posns (nth 9 ppss)) (parent @@ -785,8 +787,6 @@ or to switch back to an existing one." nil))) (comment-indent-default))) -(define-obsolete-function-alias 'lisp-mode-auto-fill 'do-auto-fill "23.1") - (defcustom lisp-indent-offset nil "If non-nil, indent second line of expressions that many more columns." :group 'lisp diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 043cf01d2e9..8c18557c79a 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -482,7 +482,8 @@ is called as a function to find the defun's end." (if (looking-at "\\s<\\|\n") (forward-line 1)))))) (funcall end-of-defun-function) - (funcall skip) + (when (<= arg 1) + (funcall skip)) (cond ((> arg 0) ;; Moving forward. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 88bb0a8bd6c..8d8d071031c 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -255,9 +255,9 @@ Left-fold the list L, starting with X, by the binary function F." x) (defun rx--normalise-or-arg (form) - "Normalise the `or' argument FORM. + "Normalize the `or' argument FORM. Characters become strings, user-definitions and `eval' forms are expanded, -and `or' forms are normalised recursively." +and `or' forms are normalized recursively." (cond ((characterp form) (char-to-string form)) ((and (consp form) (memq (car form) '(or |))) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 4c1a1797adc..1cc68e19edd 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -492,6 +492,7 @@ keys. Keys are compared using `equal'." SEQUENCE must be a sequence of numbers or markers." (apply #'min (seq-into sequence 'list))) +;;;###autoload (cl-defgeneric seq-max (sequence) "Return the largest element of SEQUENCE. SEQUENCE must be a sequence of numbers or markers." diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index ca7fcaf2d91..dd7648c2b77 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -466,24 +466,7 @@ (assoc major-mode viper-emacs-state-modifier-alist))) (cdr (assoc major-mode viper-emacs-state-modifier-alist)) - viper-empty-keymap)) - )) - - ;; This var is not local in Emacs, so we make it local. It must be local - ;; because although the stack of minor modes can be the same for all buffers, - ;; the associated *keymaps* can be different. In Viper, - ;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have - ;; different keymaps for different buffers. Also, the keymaps associated - ;; with viper-vi/insert-state-modifier-minor-mode can be different. - ;; ***This is needed only in case emulation-mode-map-alists is not defined. - ;; In emacs with emulation-mode-map-alists, nothing needs to be done - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (set (make-local-variable 'minor-mode-map-alist) - (viper-append-filter-alist - (append viper--intercept-key-maps viper--key-maps) - minor-mode-map-alist))) - ) + viper-empty-keymap))))) @@ -711,7 +694,7 @@ ARG is used as the prefix value for the executed command. If EVENTS is a list of events, which become the beginning of the command." (interactive "P") - (if (viper= (viper-last-command-char) ?\\) + (if (viper= last-command-event ?\\) (message "Switched to EMACS state for the next command...")) (viper-escape-to-state arg events 'emacs-state)) @@ -893,16 +876,7 @@ LOAD-FILE is the name of the file where the specific minor mode is defined. Suffixes such as .el or .elc should be stripped." (interactive "sEnter name of the load file: ") - - (eval-after-load load-file '(viper-normalize-minor-mode-map-alist)) - - ;; Change the default for minor-mode-map-alist each time a harnessed minor - ;; mode adds its own keymap to the a-list. - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (eval-after-load - load-file '(setq-default minor-mode-map-alist minor-mode-map-alist))) - ) + (eval-after-load load-file '(viper-normalize-minor-mode-map-alist))) (defun viper-ESC (arg) @@ -1175,7 +1149,7 @@ as a Meta key and any number of multiple escapes are allowed." "Begin numeric argument for the next command." (interactive "P") (viper-prefix-arg-value - (viper-last-command-char) (if (consp arg) (cdr arg) nil))) + last-command-event (if (consp arg) (cdr arg) nil))) (defun viper-command-argument (arg) "Accept a motion command as an argument." @@ -1183,7 +1157,7 @@ as a Meta key and any number of multiple escapes are allowed." (let ((viper-intermediate-command 'viper-command-argument)) (condition-case nil (viper-prefix-arg-com - (viper-last-command-char) + last-command-event (cond ((null arg) nil) ((consp arg) (car arg)) ((integerp arg) arg) @@ -1590,7 +1564,7 @@ invokes the command before that, etc." ;; Hook used in viper-undo (defun viper-after-change-undo-hook (beg end _len) - (if (and (boundp 'undo-in-progress) undo-in-progress) + (if undo-in-progress (setq undo-beg-posn beg undo-end-posn (or end beg)) ;; some other hooks may be changing various text properties in @@ -1624,9 +1598,9 @@ invokes the command before that, etc." (pos-visible-in-window-p before-undo-pt)) (progn (push-mark (point-marker) t) - (viper-sit-for-short 300) + (sit-for 0.3) (goto-char undo-end-posn) - (viper-sit-for-short 300) + (sit-for 0.3) (if (pos-visible-in-window-p undo-beg-posn) (goto-char before-undo-pt) (goto-char undo-beg-posn))) @@ -1912,15 +1886,11 @@ Undo previous insertion and inserts new." (or unread-command-events executing-kbd-macro (sit-for 840)) - (if (fboundp 'minibuffer-prompt-end) - (delete-region (minibuffer-prompt-end) (point-max)) - (erase-buffer)) + (delete-region (minibuffer-prompt-end) (point-max)) (insert viper-initial))) (defsubst viper-minibuffer-real-start () - (if (fboundp 'minibuffer-prompt-end) - (minibuffer-prompt-end) - (point-min))) + (minibuffer-prompt-end)) (defun viper-minibuffer-post-command-hook() (when (active-minibuffer-window) @@ -1934,7 +1904,7 @@ Undo previous insertion and inserts new." "Exit minibuffer Viper way." (interactive) (let (command) - (setq command (local-key-binding (char-to-string (viper-last-command-char)))) + (setq command (local-key-binding (char-to-string last-command-event))) (run-hooks 'viper-minibuffer-exit-hook) (if command (command-execute command) @@ -2909,7 +2879,7 @@ If point is on a widget or a button, simulate clicking on that widget/button." (and (consp widget) (get (widget-type widget) 'widget-type)))) (widget-button-press (point)) - (if (and (fboundp 'button-at) (fboundp 'push-button) (button-at (point))) + (if (button-at (point)) (push-button) ;; not a widget or a button (save-excursion @@ -4721,8 +4691,7 @@ Please, specify your level now: ")) (interactive "cViper register to point: ") (let ((val (get-register char))) (cond - ((and (fboundp 'frame-configuration-p) - (frame-configuration-p val)) + ((frame-configuration-p val) (set-frame-configuration val)) ((window-configuration-p val) (set-window-configuration val)) @@ -4765,8 +4734,7 @@ Please, specify your level now: ")) (viper-color-display-p (if (viper-window-display-p) (viper-color-display-p) 'non-x)) - (viper-frame-parameters (if (fboundp 'frame-parameters) - (frame-parameters (selected-frame)))) + (viper-frame-parameters (frame-parameters (selected-frame))) (viper-minibuffer-emacs-face (if (viper-has-face-support-p) (facep viper-minibuffer-emacs-face) diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 6ecfec548cb..928a3ef00ee 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -98,7 +98,7 @@ considered related." ;;; Code (defsubst viper-multiclick-p () - (not (viper-sit-for-short viper-multiclick-timeout t))) + (not (sit-for (/ viper-multiclick-timeout 1000.0) t))) ;; Returns window where click occurs (defun viper-mouse-click-window (click) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 1561204151d..83e45e1cd0c 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -786,14 +786,11 @@ Otherwise return the normal value." (defun viper-check-minibuffer-overlay () (if (overlayp viper-minibuffer-overlay) (move-overlay - viper-minibuffer-overlay - (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) - (1+ (buffer-size))) + viper-minibuffer-overlay (minibuffer-prompt-end) (1+ (buffer-size))) (setq viper-minibuffer-overlay ;; make overlay open-ended (make-overlay - (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) - (1+ (buffer-size)) + (minibuffer-prompt-end) (1+ (buffer-size)) (current-buffer) nil 'rear-advance)))) @@ -808,9 +805,8 @@ Otherwise return the normal value." (define-obsolete-function-alias 'viper-abbreviate-file-name 'abbreviate-file-name "27.1") -;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg -;; in sit-for, so this function smooths out the differences. (defsubst viper-sit-for-short (val &optional nodisp) + (declare (obsolete nil "28.1")) (sit-for (/ val 1000.0) nodisp)) ;; EVENT may be a single event of a sequence of events @@ -868,11 +864,10 @@ Otherwise return the normal value." ;; Uses different timeouts for ESC-sequences and others (defun viper-fast-keysequence-p () - (not (viper-sit-for-short - (if (viper-ESC-event-p last-input-event) - (viper-ESC-keyseq-timeout) - viper-fast-keyseq-timeout) - t))) + (not (sit-for (/ (if (viper-ESC-event-p last-input-event) + (viper-ESC-keyseq-timeout) + viper-fast-keyseq-timeout) 1000.0) + t))) (define-obsolete-function-alias 'viper-read-event-convert-to-char 'read-event "27.1") @@ -920,6 +915,7 @@ Otherwise return the normal value." basis))) (defun viper-last-command-char () + (declare (obsolete nil "28.1")) last-command-event) (defun viper-key-to-emacs-key (key) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 8e7a34fc69c..59ca6298eb9 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -695,9 +695,6 @@ It also can't undo some Viper settings." 'mark-even-if-inactive viper-saved-non-viper-variables)) ;; Ideally, we would like to be able to de-localize local variables - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (viper-delocalize-var 'minor-mode-map-alist)) (viper-delocalize-var 'require-final-newline) ;; deactivate all advices done by Viper. @@ -705,11 +702,9 @@ It also can't undo some Viper settings." (setq viper-mode nil) - (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (setq emulation-mode-map-alists - (delq 'viper--intercept-key-maps - (delq 'viper--key-maps emulation-mode-map-alists)) - )) + (setq emulation-mode-map-alists + (delq 'viper--intercept-key-maps + (delq 'viper--key-maps emulation-mode-map-alists))) (viper-delocalize-var 'viper-vi-minibuffer-minor-mode) (viper-delocalize-var 'viper-insert-minibuffer-minor-mode) @@ -943,13 +938,11 @@ Two differences: (setq viper-vi-state-cursor-color color-name))) - (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - ;; needs to be as early as possible - (add-to-ordered-list - 'emulation-mode-map-alists 'viper--intercept-key-maps 100) - ;; needs to be after cua-mode - (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500) - ) + ;; needs to be as early as possible + (add-to-ordered-list + 'emulation-mode-map-alists 'viper--intercept-key-maps 100) + ;; needs to be after cua-mode + (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500) ;; Emacs shell, ange-ftp, and comint-based modes (add-hook 'comint-mode-hook #'viper-comint-mode-hook) ; comint @@ -1062,10 +1055,7 @@ This may be needed if the previous `:map' command terminated abnormally." (viper--advice-add 'add-minor-mode :after (lambda (&rest _) "Run viper-normalize-minor-mode-map-alist after adding a minor mode." - (viper-normalize-minor-mode-map-alist) - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (setq-default minor-mode-map-alist minor-mode-map-alist)))) + (viper-normalize-minor-mode-map-alist))) ;; catch frame switching event (if (viper-window-display-p) @@ -1253,12 +1243,7 @@ These two lines must come in the order given.")) ;; Without setting the default, new buffers that come up in emacs mode have ;; minor-mode-map-alist = nil, unless we call viper-change-state-* (when (eq viper-current-state 'emacs-state) - (viper-change-state-to-emacs) - (unless - (and (fboundp 'add-to-ordered-list) - (boundp 'emulation-mode-map-alists)) - (setq-default minor-mode-map-alist minor-mode-map-alist)) - ) + (viper-change-state-to-emacs)) (if (this-major-mode-requires-vi-state major-mode) (viper-mode)) diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el index 9269ea97070..4ff1ba33941 100644 --- a/lisp/epa-dired.el +++ b/lisp/epa-dired.el @@ -1,4 +1,5 @@ ;;; epa-dired.el --- the EasyPG Assistant, dired extension -*- lexical-binding: t -*- + ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> diff --git a/lisp/epa-file.el b/lisp/epa-file.el index bbd9279a9a8..3b0cc84e5f6 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -1,4 +1,5 @@ ;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*- + ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> @@ -21,10 +22,13 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Dependencies (require 'epa) (require 'epa-hook) +;;; Options + (defcustom epa-file-cache-passphrase-for-symmetric-encryption nil "If non-nil, cache passphrase for symmetric encryption. @@ -49,6 +53,8 @@ encryption is used." (const :tag "Don't ask" silent)) :group 'epa-file) +;;; Other + (defvar epa-file-passphrase-alist nil) (defun epa-file-passphrase-callback-function (context key-id file) @@ -72,6 +78,8 @@ encryption is used." passphrase)))) (epa-passphrase-callback-function context key-id file))) +;;; File Handler + (defvar epa-inhibit nil "Non-nil means don't try to decrypt .gpg files when operating on them.") @@ -311,6 +319,8 @@ If no one is selected, symmetric encryption will be performed. " (message "Wrote %s" buffer-file-name)))) (put 'write-region 'epa-file 'epa-file-write-region) +;;; Commands + (defun epa-file-select-keys () "Select recipients for encryption." (interactive) diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index a86f23eb688..6f12f8a6bfa 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -1,4 +1,5 @@ ;;; epa-hook.el --- preloaded code to enable epa-file.el -*- lexical-binding: t -*- + ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 63475256ca8..6e6c0a498d2 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -1,4 +1,5 @@ ;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*- + ;; Copyright (C) 2006-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> @@ -21,10 +22,13 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Dependencies (require 'epa) (require 'mail-utils) +;;; Local Mode + (defvar epa-mail-mode-map (let ((keymap (make-sparse-keymap))) (define-key keymap "\C-c\C-ed" 'epa-mail-decrypt) @@ -50,6 +54,8 @@ "A minor-mode for composing encrypted/clearsigned mails." nil " epa-mail" epa-mail-mode-map) +;;; Utilities + (defun epa-mail--find-usable-key (keys usage) "Find a usable key from KEYS for USAGE. USAGE would be `sign' or `encrypt'." @@ -64,6 +70,8 @@ USAGE would be `sign' or `encrypt'." (setq pointer (cdr pointer)))) (setq keys (cdr keys))))) +;;; Commands + ;;;###autoload (defun epa-mail-decrypt () "Decrypt OpenPGP armors in the current buffer. @@ -241,6 +249,8 @@ The buffer is expected to contain a mail message." (interactive) (epa-import-armor-in-region (point-min) (point-max))) +;;; Global Mode + ;;;###autoload (define-minor-mode epa-global-mail-mode "Minor mode to hook EasyPG into Mail mode." diff --git a/lisp/epa.el b/lisp/epa.el index 3c7dd8309a8..5140d3f0a69 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -21,6 +21,7 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Dependencies (require 'epg) (require 'font-lock) @@ -30,6 +31,8 @@ (require 'wid-edit)) (require 'derived) +;;; Options + (defgroup epa nil "The EasyPG Assistant" :version "23.1" @@ -73,6 +76,8 @@ The command `epa-mail-encrypt' uses this." :group 'epa :version "24.4") +;;; Faces + (defgroup epa-faces nil "Faces for epa-mode." :version "23.1" @@ -146,6 +151,8 @@ The command `epa-mail-encrypt' uses this." :type '(repeat (cons symbol face)) :group 'epa-faces) +;;; Variables + (defvar epa-font-lock-keywords '(("^\\*" (0 'epa-mark)) @@ -252,6 +259,8 @@ You should bind this variable with `let', but do not set it globally.") (defvar epa-exit-buffer-function #'quit-window) +;;; Key Widget + (define-widget 'epa-key 'push-button "Button for representing an epg-key object." :format "%[%v%]" @@ -293,6 +302,8 @@ You should bind this variable with `let', but do not set it globally.") (epg-sub-key-id (car (epg-key-sub-key-list (widget-get widget :value)))))) +;;; Modes + (define-derived-mode epa-key-list-mode special-mode "EPA Keys" "Major mode for `epa-list-keys'." (buffer-disable-undo) @@ -316,6 +327,9 @@ You should bind this variable with `let', but do not set it globally.") (setq truncate-lines t buffer-read-only t)) +;;; Commands +;;;; Marking + (defun epa-mark-key (&optional arg) "Mark a key on the current line. If ARG is non-nil, unmark the key." @@ -338,11 +352,15 @@ If ARG is non-nil, mark the key." (interactive "P") (epa-mark-key (not arg))) +;;;; Quitting + (defun epa-exit-buffer () "Exit the current buffer using `epa-exit-buffer-function'." (interactive) (funcall epa-exit-buffer-function)) +;;;; Listing and Selecting + (defun epa--insert-keys (keys) (save-excursion (save-restriction @@ -505,6 +523,8 @@ If SECRET is non-nil, list secret keys instead of public keys." (let ((keys (epg-list-keys context names secret))) (epa--select-keys prompt keys))) +;;;; Key Details + (defun epa-show-key () "Show a key on the current line." (interactive) @@ -591,6 +611,8 @@ If SECRET is non-nil, list secret keys instead of public keys." (goto-char (point-min)) (pop-to-buffer (current-buffer)))) +;;;; Encryption and Signatures + (defun epa-display-info (info) (if epa-popup-info-window (save-selected-window @@ -644,10 +666,6 @@ If SECRET is non-nil, list secret keys instead of public keys." (goto-char (point-min))) (display-buffer buffer))))) -(defun epa-display-verify-result (verify-result) - (declare (obsolete epa-display-info "23.1")) - (epa-display-info (epg-verify-result-to-string verify-result))) - (defun epa-passphrase-callback-function (context key-id handback) (if (eq key-id 'SYM) (read-passwd @@ -1105,16 +1123,7 @@ If no one is selected, default secret key is used. " 'start-open t 'end-open t))))) -(defalias 'epa--derived-mode-p - (if (fboundp 'derived-mode-p) - #'derived-mode-p - (lambda (&rest modes) - "Non-nil if the current major mode is derived from one of MODES. -Uses the `derived-mode-parent' property of the symbol to trace backwards." - (let ((parent major-mode)) - (while (and (not (memq parent modes)) - (setq parent (get parent 'derived-mode-parent)))) - parent)))) +(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1") ;;;###autoload (defun epa-encrypt-region (start end recipients sign signers) @@ -1191,6 +1200,8 @@ If no one is selected, symmetric encryption will be performed. ") 'start-open t 'end-open t))))) +;;;; Key Management + ;;;###autoload (defun epa-delete-keys (keys &optional allow-secret) "Delete selected KEYS." @@ -1227,7 +1238,7 @@ If no one is selected, symmetric encryption will be performed. ") (if (epg-context-result-for context 'import) (epa-display-info (epg-import-result-to-string (epg-context-result-for context 'import)))) - ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p? + ;; FIXME: Why not use the derived-mode-p? (if (eq major-mode 'epa-key-list-mode) (apply #'epa--list-keys epa-list-keys-arguments)))) diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 1c429246529..9f0c7e4c509 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -22,6 +22,7 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Prelude (eval-when-compile (require 'cl-lib)) @@ -34,6 +35,8 @@ (define-obsolete-variable-alias 'epg-bug-report-address 'report-emacs-bug-address "27.1") +;;; Options + (defgroup epg () "Interface to the GNU Privacy Guard (GnuPG)." :tag "EasyPG" @@ -106,6 +109,8 @@ through the minibuffer, instead of external Pinentry program." Note that the buffer name starts with a space." :type 'boolean) +;;; Constants + (defconst epg-gpg-minimum-version "1.4.3") (defconst epg-gpg2-minimum-version "2.1.6") @@ -133,6 +138,8 @@ The first element of each entry is protocol symbol, which is either `OpenPGP' or `CMS'. The second element is a function which constructs a configuration object (actually a plist).") +;;; "Configuration" + (defvar epg--configurations nil) ;;;###autoload diff --git a/lisp/epg.el b/lisp/epg.el index 5b90bc290ab..920b85398f3 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -1,4 +1,5 @@ ;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*- + ;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> @@ -21,10 +22,15 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Code: +;;; Prelude (require 'epg-config) (eval-when-compile (require 'cl-lib)) +(define-error 'epg-error "GPG error") + +;;; Variables + (defvar epg-user-id nil "GnuPG ID of your default identity.") @@ -41,6 +47,8 @@ (defvar epg-agent-file nil) (defvar epg-agent-mtime nil) +;;; Enums + ;; from gnupg/common/openpgpdefs.h (defconst epg-cipher-algorithm-alist '((0 . "NONE") @@ -123,7 +131,7 @@ (defconst epg-no-data-reason-alist '((1 . "No armored data") - (2 . "Expected a packet but did not found one") + (2 . "Expected a packet but did not find one") (3 . "Invalid packet found, this may indicate a non OpenPGP message") (4 . "Signature expected but not found"))) @@ -169,7 +177,8 @@ (defvar epg-prompt-alist nil) -(define-error 'epg-error "GPG error") +;;; Structs +;;;; Data Struct (cl-defstruct (epg-data (:constructor nil) @@ -180,6 +189,9 @@ (file nil :read-only t) (string nil :read-only t)) +;;;; Context Struct +(declare-function epa-passphrase-callback-function "epa.el") + (cl-defstruct (epg-context (:constructor nil) (:constructor epg-context--make @@ -204,7 +216,7 @@ cipher-algorithm digest-algorithm compress-algorithm - (passphrase-callback (list #'epg-passphrase-callback-function)) + (passphrase-callback (list #'epa-passphrase-callback-function)) progress-callback edit-callback signers @@ -218,6 +230,8 @@ (error-output "") error-buffer) +;;;; Context Methods + ;; This is not an alias, just so we can mark it as autoloaded. ;;;###autoload (defun epg-make-context (&optional protocol armor textmode include-certs @@ -281,6 +295,8 @@ callback data (if any)." (declare (obsolete setf "25.1")) (setf (epg-context-signers context) signers)) +;;;; Other Structs + (cl-defstruct (epg-signature (:constructor nil) (:constructor epg-make-signature @@ -385,6 +401,8 @@ callback data (if any)." secret-unchanged not-imported imports) +;;; Functions + (defun epg-context-result-for (context name) "Return the result of CONTEXT associated with NAME." (cdr (assq name (epg-context-result context)))) @@ -404,37 +422,28 @@ callback data (if any)." (pubkey-algorithm (epg-signature-pubkey-algorithm signature)) (key-id (epg-signature-key-id signature))) (concat - (cond ((eq (epg-signature-status signature) 'good) - "Good signature from ") - ((eq (epg-signature-status signature) 'bad) - "Bad signature from ") - ((eq (epg-signature-status signature) 'expired) - "Expired signature from ") - ((eq (epg-signature-status signature) 'expired-key) - "Signature made by expired key ") - ((eq (epg-signature-status signature) 'revoked-key) - "Signature made by revoked key ") - ((eq (epg-signature-status signature) 'no-pubkey) - "No public key for ")) + (cl-case (epg-signature-status signature) + (good "Good signature from ") + (bad "Bad signature from ") + (expired "Expired signature from ") + (expired-key "Signature made by expired key ") + (revoked-key "Signature made by revoked key ") + (no-pubkey "No public key for ")) key-id - (if user-id - (concat " " - (if (stringp user-id) - (epg--decode-percent-escape-as-utf-8 user-id) - (epg-decode-dn user-id))) - "") - (if (epg-signature-validity signature) - (format " (trust %s)" (epg-signature-validity signature)) - "") - (if (epg-signature-creation-time signature) - (format-time-string " created at %Y-%m-%dT%T%z" - (epg-signature-creation-time signature)) - "") - (if pubkey-algorithm - (concat " using " - (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist)) - (format "(unknown algorithm %d)" pubkey-algorithm))) - "")))) + (and user-id + (concat " " + (if (stringp user-id) + (epg--decode-percent-escape-as-utf-8 user-id) + (epg-decode-dn user-id)))) + (and (epg-signature-validity signature) + (format " (trust %s)" (epg-signature-validity signature))) + (and (epg-signature-creation-time signature) + (format-time-string " created at %Y-%m-%dT%T%z" + (epg-signature-creation-time signature))) + (and pubkey-algorithm + (concat " using " + (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist)) + (format "(unknown algorithm %d)" pubkey-algorithm))))))) (defun epg-verify-result-to-string (verify-result) "Convert VERIFY-RESULT to a human readable string." @@ -859,6 +868,8 @@ callback data (if any)." (format "Untrusted key %s %s. Use anyway? " key-id user-id)) "Use untrusted key anyway? "))) +;;; Status Functions + (defun epg--status-GET_BOOL (context string) (let (inhibit-quit) (condition-case nil @@ -1234,18 +1245,7 @@ callback data (if any)." (epg-context-result-for context 'import-status))) (epg-context-set-result-for context 'import-status nil))) -(defun epg-passphrase-callback-function (context key-id _handback) - (declare (obsolete epa-passphrase-callback-function "23.1")) - (if (eq key-id 'SYM) - (read-passwd "Passphrase for symmetric encryption: " - (eq (epg-context-operation context) 'encrypt)) - (read-passwd - (if (eq key-id 'PIN) - "Passphrase for PIN: " - (let ((entry (assoc key-id epg-user-id-alist))) - (if entry - (format "Passphrase for %s %s: " key-id (cdr entry)) - (format "Passphrase for %s: " key-id))))))) +;;; Functions (defun epg--list-keys-1 (context name mode) (let ((args (append (if (epg-context-home-directory context) @@ -1303,6 +1303,8 @@ callback data (if any)." (if (aref line 6) (epg--time-from-seconds (aref line 6))))) +;;; Public Functions + (defun epg-list-keys (context &optional name mode) "Return a list of epg-key objects matched with NAME. If MODE is nil or `public', only public keyring should be searched. @@ -2032,6 +2034,8 @@ If you are unsure, use synchronous version of this function (epg-errors-to-string errors)))))) (epg-reset context))) +;;; Decode Functions + (defun epg--decode-percent-escape (string) (setq string (encode-coding-string string 'raw-text)) (let ((index 0)) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 4f3d85ba3c8..1cf0bb49217 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -98,7 +98,6 @@ ;;; Code: -(require 'erc-compat) (eval-when-compile (require 'cl-lib)) ;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. ;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the @@ -782,7 +781,7 @@ value of `erc-server-coding-system'." (pop precedence)) (when precedence (setq coding (car precedence))))) - (erc-decode-coding-string str coding))) + (decode-coding-string str coding t))) ;; proposed name, not used by anything yet (defun erc-send-line (text display-fn) diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index fc45725f789..4afe6a7614b 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -170,11 +170,11 @@ PARSED is an `erc-parsed' response struct." (string-match "^\\([-\\+]\\)\\(.+\\)$" msg)) (setf (erc-response.contents parsed) (if erc-capab-identify-mode - (erc-propertize (match-string 2 msg) - 'erc-identified - (if (string= (match-string 1 msg) "+") - 1 - 0)) + (propertize (match-string 2 msg) + 'erc-identified + (if (string= (match-string 1 msg) "+") + 1 + 0)) (match-string 2 msg))) nil))) @@ -190,9 +190,9 @@ PARSED is an `erc-parsed' response struct." ;; assuming the first use of `nickname' is the sender's nick (re-search-forward (regexp-quote nickname) nil t)) (goto-char (match-beginning 0)) - (insert (erc-propertize erc-capab-identify-prefix - 'font-lock-face - 'erc-capab-identify-unidentified)))))) + (insert (propertize erc-capab-identify-prefix + 'font-lock-face + 'erc-capab-identify-unidentified)))))) (defun erc-capab-identify-get-unidentified-nickname (parsed) "Return the nickname of the user if unidentified. diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 8ccceec4594..477f148197b 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -419,15 +419,15 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcomplete-here (pcase (intern (downcase (pcomplete-arg 1))) ('chat (mapcar (lambda (elt) (plist-get elt :nick)) - (erc-remove-if-not + (cl-remove-if-not #'(lambda (elt) (eq (plist-get elt :type) 'CHAT)) erc-dcc-list))) - ('close (erc-delete-dups + ('close (delete-dups (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) erc-dcc-list))) ('get (mapcar #'erc-dcc-nick - (erc-remove-if-not + (cl-remove-if-not #'(lambda (elt) (eq (plist-get elt :type) 'GET)) erc-dcc-list))) @@ -435,7 +435,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcomplete-here (pcase (intern (downcase (pcomplete-arg 2))) ('get (mapcar (lambda (elt) (plist-get elt :file)) - (erc-remove-if-not + (cl-remove-if-not #'(lambda (elt) (and (eq (plist-get elt :type) 'GET) (erc-nick-equal-p (erc-extract-nick @@ -443,7 +443,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcomplete-arg 1)))) erc-dcc-list))) ('close (mapcar #'erc-dcc-nick - (erc-remove-if-not + (cl-remove-if-not #'(lambda (elt) (eq (plist-get elt :type) (intern (upcase (pcomplete-arg 1))))) @@ -636,8 +636,8 @@ that subcommand." (define-inline erc-dcc-unquote-filename (filename) (inline-quote - (erc-replace-regexp-in-string "\\\\\\\\" "\\" - (erc-replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t))) + (replace-regexp-in-string "\\\\\\\\" "\\" + (replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t))) (defun erc-dcc-handle-ctcp-send (proc query nick login host to) "This is called if a CTCP DCC SEND subcommand is sent to the client. @@ -1193,8 +1193,8 @@ other client." (setq posn (match-end 0)) (erc-display-message nil nil proc - 'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'font-lock-face - 'erc-nick-default-face) ?m line)) + 'dcc-chat-privmsg ?n (propertize erc-dcc-from 'font-lock-face + 'erc-nick-default-face) ?m line)) (setq erc-dcc-unprocessed-output (substring str posn))))) (defun erc-dcc-chat-buffer-killed () diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 39a8be5e0cf..d09caf7aa12 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -38,7 +38,7 @@ :group 'erc) ;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t) -(erc-define-minor-mode erc-fill-mode +(define-minor-mode erc-fill-mode "Toggle ERC fill mode. With a prefix argument ARG, enable ERC fill mode if ARG is positive, and disable it otherwise. If called from Lisp, enable diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 94d5de280c6..a475f0a1770 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -232,6 +232,10 @@ The value `erc-interpret-controls-p' must also be t for this to work." "ERC bold face." :group 'erc-faces) +(defface erc-italic-face '((t :slant italic)) + "ERC italic face." + :group 'erc-faces) + (defface erc-inverse-face '((t :foreground "White" :background "Black")) "ERC inverse face." @@ -383,6 +387,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (erc-controls-strip s)) (erc-interpret-controls-p (let ((boldp nil) + (italicp nil) (inversep nil) (underlinep nil) (fg nil) @@ -394,13 +399,14 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (start (match-beginning 0)) (end (+ (match-beginning 0) (length (match-string 5 s))))) - (setq s (erc-replace-match-subexpression-in-string - "" s control 1 start)) + (setq s (replace-match "" nil nil s 1)) (cond ((and erc-interpret-mirc-color (or fg-color bg-color)) (setq fg fg-color) (setq bg bg-color)) ((string= control "\C-b") (setq boldp (not boldp))) + ((string= control "\C-]") + (setq italicp (not italicp))) ((string= control "\C-v") (setq inversep (not inversep))) ((string= control "\C-_") @@ -413,13 +419,14 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (ding))) ((string= control "\C-o") (setq boldp nil + italicp nil inversep nil underlinep nil fg nil bg nil)) (t nil)) (erc-controls-propertize - start end boldp inversep underlinep fg bg s))) + start end boldp italicp inversep underlinep fg bg s))) s)) (t s))))) @@ -432,13 +439,13 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." s))) (defvar erc-controls-remove-regexp - "\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?" + "\C-b\\|\C-]\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?" "Regular expression which matches control characters to remove.") (defvar erc-controls-highlight-regexp - (concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|" + (concat "\\(\C-b\\|\C-]\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|" "\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)" - "\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)") + "\\([^\C-b\C-]\C-v\C-_\C-c\C-g\C-o\n]*\\)") "Regular expression which matches control chars and the text to highlight.") (defun erc-controls-highlight () @@ -451,6 +458,7 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (replace-match ""))) (erc-interpret-controls-p (let ((boldp nil) + (italicp nil) (inversep nil) (underlinep nil) (fg nil) @@ -467,6 +475,8 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (setq bg bg-color)) ((string= control "\C-b") (setq boldp (not boldp))) + ((string= control "\C-]") + (setq italicp (not italicp))) ((string= control "\C-v") (setq inversep (not inversep))) ((string= control "\C-_") @@ -479,16 +489,17 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (ding))) ((string= control "\C-o") (setq boldp nil + italicp nil inversep nil underlinep nil fg nil bg nil)) (t nil)) (erc-controls-propertize start end - boldp inversep underlinep fg bg))))) + boldp italicp inversep underlinep fg bg))))) (t nil))) -(defun erc-controls-propertize (from to boldp inversep underlinep fg bg +(defun erc-controls-propertize (from to boldp italicp inversep underlinep fg bg &optional str) "Prepend properties from IRC control characters between FROM and TO. If optional argument STR is provided, apply to STR, otherwise prepend properties @@ -500,6 +511,9 @@ to a region in the current buffer." (append (if boldp '(erc-bold-face) nil) + (if italicp + '(erc-italic-face) + nil) (if inversep '(erc-inverse-face) nil) diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index e4faf6bd797..79c111082f6 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -153,18 +153,20 @@ This function is run from `erc-nickserv-identified-hook'." 'erc-autojoin-channels-delayed server nick (current-buffer)))) ;; `erc-autojoin-timing' is `connect': - (dolist (l erc-autojoin-channels-alist) - (when (string-match (car l) server) - (let ((server (or erc-session-server erc-server-announced-name))) + (let ((server (or erc-session-server erc-server-announced-name))) + (dolist (l erc-autojoin-channels-alist) + (when (string-match-p (car l) server) (dolist (chan (cdr l)) - (let ((buffer (erc-get-buffer chan))) - ;; Only auto-join the channels that we aren't already in - ;; using a different nick. + (let ((buffer + (car (erc-buffer-filter + (lambda () + (let ((current (erc-default-target))) + (and (stringp current) + (string-match-p (car l) + (or erc-session-server erc-server-announced-name)) + (string-equal (erc-downcase chan) + (erc-downcase current))))))))) (when (or (not buffer) - ;; If the same channel is joined on another - ;; server the best-effort is to just join - (not (string-match (car l) - (process-name erc-server-process))) (not (with-current-buffer buffer (erc-server-process-alive)))) (erc-server-join-channel server chan)))))))) diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index 5faeabb721a..036d7733ed7 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el @@ -71,13 +71,13 @@ (defun erc-list-make-string (channel users topic) (concat channel - (erc-propertize " " - 'display (list 'space :align-to erc-list-nusers-column) - 'face 'fixed-pitch) + (propertize " " + 'display (list 'space :align-to erc-list-nusers-column) + 'face 'fixed-pitch) users - (erc-propertize " " - 'display (list 'space :align-to erc-list-topic-column) - 'face 'fixed-pitch) + (propertize " " + 'display (list 'space :align-to erc-list-topic-column) + 'face 'fixed-pitch) topic)) ;; Insert a record into the list buffer. @@ -143,19 +143,19 @@ ;; Helper function that makes a buttonized column header. (defun erc-list-button (title column) - (erc-propertize title - 'column-number column - 'help-echo "mouse-1: sort by column" - 'mouse-face 'header-line-highlight - 'keymap erc-list-menu-sort-button-map)) + (propertize title + 'column-number column + 'help-echo "mouse-1: sort by column" + 'mouse-face 'header-line-highlight + 'keymap erc-list-menu-sort-button-map)) (define-derived-mode erc-list-menu-mode special-mode "ERC-List" "Major mode for editing a list of irc channels." (setq header-line-format (concat - (erc-propertize " " - 'display '(space :align-to 0) - 'face 'fixed-pitch) + (propertize " " + 'display '(space :align-to 0) + 'face 'fixed-pitch) (erc-list-make-string (erc-list-button "Channel" 1) (erc-list-button "# Users" 2) "Topic"))) diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 1bad6d16c87..2166123e674 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -267,7 +267,7 @@ The current buffer is given by BUFFER." (with-current-buffer buffer (auto-save-mode -1) (setq buffer-file-name nil) - (erc-set-write-file-functions '(erc-save-buffer-in-logs)) + (set (make-local-variable 'write-file-functions) '(erc-save-buffer-in-logs)) (when erc-log-insert-log-on-open (ignore-errors (save-excursion @@ -334,7 +334,7 @@ This will not work with full paths, only names. Any unsafe characters in the name are replaced with \"!\". The filename is downcased." - (downcase (erc-replace-regexp-in-string + (downcase (replace-regexp-in-string "[/\\]" "!" (convert-standard-filename filename)))) (defun erc-current-logfile (&optional buffer) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 0e98f2bc613..b3145674f29 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -94,7 +94,9 @@ The following values are allowed: `nick-or-keyword' - highlight the nick of the user who typed your nickname, or all instances of the current nickname if there was no sending user - `all' - highlight the entire message where current nickname occurs + `message' - highlight the entire message where current nickname occurs + `all' - highlight the entire message (including the nick) where + current nickname occurs Any other value disables highlighting of current nickname altogether." :group 'erc-match @@ -102,6 +104,7 @@ Any other value disables highlighting of current nickname altogether." (const nick) (const keyword) (const nick-or-keyword) + (const message) (const all))) (defcustom erc-pal-highlight-type 'nick @@ -110,14 +113,17 @@ See `erc-pals'. The following values are allowed: - nil - do not highlight the message at all - `nick' - highlight pal's nickname only - `all' - highlight the entire message from pal + nil - do not highlight the message at all + `nick' - highlight pal's nickname only + `message' - highlight the entire message from pal + `all' - highlight the entire message (including the nick) + from pal Any other value disables pal highlighting altogether." :group 'erc-match :type '(choice (const nil) (const nick) + (const message) (const all))) (defcustom erc-fool-highlight-type 'nick @@ -126,14 +132,17 @@ See `erc-fools'. The following values are allowed: - nil - do not highlight the message at all - `nick' - highlight fool's nickname only - `all' - highlight the entire message from fool + nil - do not highlight the message at all + `nick' - highlight fool's nickname only + `message' - highlight the entire message from fool + `all' - highlight the entire message (including the nick) + from fool Any other value disables fool highlighting altogether." :group 'erc-match :type '(choice (const nil) (const nick) + (const message) (const all))) (defcustom erc-keyword-highlight-type 'keyword @@ -143,12 +152,15 @@ See variable `erc-keywords'. The following values are allowed: `keyword' - highlight keyword only - `all' - highlight the entire message containing keyword + `message' - highlight the entire message containing keyword + `all' - highlight the entire message (including the nick) + containing keyword Any other value disables keyword highlighting altogether." :group 'erc-match :type '(choice (const nil) (const keyword) + (const message) (const all))) (defcustom erc-dangerous-host-highlight-type 'nick @@ -157,13 +169,16 @@ See `erc-dangerous-hosts'. The following values are allowed: - `nick' - highlight nick from dangerous-host only - `all' - highlight the entire message from dangerous-host + `nick' - highlight nick from dangerous-host only + `message' - highlight the entire message from dangerous-host + `all' - highlight the entire message (including the nick) + from dangerous-host Any other value disables dangerous-host highlighting altogether." :group 'erc-match :type '(choice (const nil) (const nick) + (const message) (const all))) @@ -449,19 +464,18 @@ Use this defun with `erc-insert-modify-hook'." (match-beginning 0))) (nick-end (when nick-beg (match-end 0))) - (message (buffer-substring - (if (and nick-end - (<= (+ 2 nick-end) (point-max))) - ;; Message starts 2 characters after the nick - ;; except for CTCP ACTION messages. Nick - ;; surrounded by angle brackets only in normal - ;; messages. - (+ nick-end - (if (eq ?> (char-after nick-end)) - 2 - 1)) - (point-min)) - (point-max)))) + (message-beg (if (and nick-end + (<= (+ 2 nick-end) (point-max))) + ;; Message starts 2 characters after the + ;; nick except for CTCP ACTION messages. + ;; Nick surrounded by angle brackets only in + ;; normal messages. + (+ nick-end + (if (eq ?> (char-after nick-end)) + 2 + 1)) + (point-min))) + (message (buffer-substring message-beg (point-max)))) (when (and vector (not (and erc-match-exclude-server-buffer (erc-server-buffer-p)))) @@ -498,7 +512,12 @@ Use this defun with `erc-insert-modify-hook'." (while (re-search-forward match-regex nil t) (erc-put-text-property (match-beginning 0) (match-end 0) 'font-lock-face match-face)))) - ;; Highlight the whole message + ;; Highlight the whole message (not including the nick) + ((eq match-htype 'message) + (erc-put-text-property + message-beg (point-max) + 'font-lock-face match-face (current-buffer))) + ;; Highlight the whole message (including the nick) ((eq match-htype 'all) (erc-put-text-property (point-min) (point-max) @@ -577,9 +596,9 @@ See `erc-log-match-format'." (with-current-buffer buffer (unless buffer-already (insert " == Type \"q\" to dismiss messages ==\n") - (erc-view-mode-enter nil (lambda (buffer) - (when (y-or-n-p "Discard messages? ") - (kill-buffer buffer))))) + (view-mode-enter nil (lambda (buffer) + (when (y-or-n-p "Discard messages? ") + (kill-buffer buffer))))) buffer))) (defun erc-log-matches-come-back (proc parsed) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 415fb53fee0..8551cdd1dee 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -812,7 +812,7 @@ As an example: (let* ((completion-ignore-case t) (net (intern (completing-read "Network: " - (erc-delete-dups + (delete-dups (mapcar (lambda (x) (list (symbol-name (nth 1 x)))) erc-server-alist))))) diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 1b092c8a6a9..144a981f832 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -181,7 +181,7 @@ nick from `erc-last-ison' to prevent any further notifications." (let ((nick (erc-extract-nick (erc-response.sender parsed)))) (when (and (erc-member-ignore-case nick erc-notify-list) (erc-member-ignore-case nick erc-last-ison)) - (setq erc-last-ison (erc-delete-if + (setq erc-last-ison (cl-delete-if (let ((nick-down (erc-downcase nick))) (lambda (el) (string= nick-down (erc-downcase el)))) diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 7643fa85b96..f8b7e13be02 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -41,7 +41,6 @@ (require 'pcomplete) (require 'erc) -(require 'erc-compat) (require 'time-date) (defgroup erc-pcomplete nil diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index cbab2f9da2b..08970f2d70e 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -35,7 +35,6 @@ ;;; Code: (require 'erc) -(require 'erc-compat) (defgroup erc-stamp nil "For long conversation on IRC it is sometimes quite diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 41d8fc1a98f..3398c8b9d0c 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -36,7 +36,6 @@ (eval-when-compile (require 'cl-lib)) (require 'erc) -(require 'erc-compat) (require 'erc-match) ;;; Code: @@ -329,9 +328,8 @@ important." (defun erc-track-remove-from-mode-line () "Remove `erc-track-modified-channels' from the mode-line." - (when (boundp 'mode-line-modes) - (setq mode-line-modes - (remove '(t erc-modified-channels-object) mode-line-modes))) + (setq mode-line-modes + (remove '(t erc-modified-channels-object) mode-line-modes)) (when (consp global-mode-string) (setq global-mode-string (delq 'erc-modified-channels-object global-mode-string)))) @@ -341,12 +339,10 @@ important." See `erc-track-position-in-mode-line' for possible values." ;; CVS Emacs has a new format string, and global-mode-string ;; is very far to the right. - (cond ((and (eq position 'before-modes) - (boundp 'mode-line-modes)) + (cond ((eq position 'before-modes) (add-to-list 'mode-line-modes '(t erc-modified-channels-object))) - ((and (eq position 'after-modes) - (boundp 'mode-line-modes)) + ((eq position 'after-modes) (add-to-list 'mode-line-modes '(t erc-modified-channels-object) t)) ((eq position t) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 62aa76d25c8..8712113790b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -57,12 +57,12 @@ (load "erc-loaddefs" nil t) -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'font-lock) +(require 'format-spec) (require 'pp) (require 'thingatpt) (require 'auth-source) -(require 'erc-compat) (require 'time-date) (require 'iso8601) (eval-when-compile (require 'subr-x)) @@ -877,8 +877,8 @@ See `erc-server-flood-margin' for other flood-related parameters.") ;; Script parameters (defcustom erc-startup-file-list - (list (concat erc-user-emacs-directory ".ercrc.el") - (concat erc-user-emacs-directory ".ercrc") + (list (concat user-emacs-directory ".ercrc.el") + (concat user-emacs-directory ".ercrc") "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") "List of files to try for a startup script. The first existent and readable one will get executed. @@ -1306,7 +1306,7 @@ Example: (enable (intern (format "erc-%s-enable" (downcase sn)))) (disable (intern (format "erc-%s-disable" (downcase sn))))) `(progn - (erc-define-minor-mode + (define-minor-mode ,mode ,(format "Toggle ERC %S mode. With a prefix argument ARG, enable %s if ARG is positive, @@ -1489,8 +1489,7 @@ Defaults to the server buffer." (define-derived-mode erc-mode fundamental-mode "ERC" "Major mode for Emacs IRC." (setq local-abbrev-table erc-mode-abbrev-table) - (when (boundp 'next-line-add-newlines) - (set (make-local-variable 'next-line-add-newlines) nil)) + (set (make-local-variable 'next-line-add-newlines) nil) (setq line-move-ignore-invisible t) (set (make-local-variable 'paragraph-separate) (concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)")) @@ -1608,36 +1607,47 @@ symbol, it may have these values: (defun erc-generate-new-buffer-name (server port target) "Create a new buffer name based on the arguments." (when (numberp port) (setq port (number-to-string port))) - (let ((buf-name (or target - (or (let ((name (concat server ":" port))) - (when (> (length name) 1) - name)) - ;; This fallback should in fact never happen - "*erc-server-buffer*"))) - buffer-name) + (let* ((buf-name (or target + (let ((name (concat server ":" port))) + (when (> (length name) 1) + name)) + ;; This fallback should in fact never happen. + "*erc-server-buffer*")) + (full-buf-name (concat buf-name "/" server)) + (dup-buf-name (buffer-name (car (erc-channel-list nil)))) + buffer-name) ;; Reuse existing buffers, but not if the buffer is a connected server ;; buffer and not if its associated with a different server than the ;; current ERC buffer. - ;; if buf-name is taken by a different connection (or by something !erc) - ;; then see if "buf-name/server" meets the same criteria - (dolist (candidate (list buf-name (concat buf-name "/" server))) - (if (and (not buffer-name) - erc-reuse-buffers - (or (not (get-buffer candidate)) - ;; Looking for a server buffer, so there's no target. - (and (not target) - (with-current-buffer (get-buffer candidate) - (and (erc-server-buffer-p) - (not (erc-server-process-alive))))) - ;; Channel buffer; check that it's from the right server. - (and target - (with-current-buffer (get-buffer candidate) - (and (string= erc-session-server server) - (erc-port-equal erc-session-port port)))))) - (setq buffer-name candidate))) - ;; if buffer-name is unset, neither candidate worked out for us, + ;; If buf-name is taken by a different connection (or by something !erc) + ;; then see if "buf-name/server" meets the same criteria. + (if (and dup-buf-name (string-match-p (concat buf-name "/") dup-buf-name)) + (setq buffer-name full-buf-name) ; ERC buffer with full name already exists. + (dolist (candidate (list buf-name full-buf-name)) + (if (and (not buffer-name) + erc-reuse-buffers + (or (not (get-buffer candidate)) + ;; Looking for a server buffer, so there's no target. + (and (not target) + (with-current-buffer (get-buffer candidate) + (and (erc-server-buffer-p) + (not (erc-server-process-alive))))) + ;; Channel buffer; check that it's from the right server. + (and target + (with-current-buffer (get-buffer candidate) + (and (string= erc-session-server server) + (erc-port-equal erc-session-port port)))))) + (setq buffer-name candidate) + (when (and (not buffer-name) (get-buffer buf-name) erc-reuse-buffers) + ;; A new buffer will be created with the name buf-name/server, rename + ;; the existing name-duplicated buffer with the same format as well. + (with-current-buffer (get-buffer buf-name) + (when (derived-mode-p 'erc-mode) ; ensure it's an erc buffer + (rename-buffer + (concat buf-name "/" (or erc-session-server erc-server-announced-name))))))))) + ;; If buffer-name is unset, neither candidate worked out for us, ;; fallback to the old <N> uniquification method: - (or buffer-name (generate-new-buffer-name (concat buf-name "/" server))))) + (or buffer-name (generate-new-buffer-name full-buf-name)))) (defun erc-get-buffer-create (server port target) "Create a new buffer based on the arguments." @@ -1863,7 +1873,7 @@ buffer rather than a server buffer.") ;; modify `transforms' to specify what needs to be changed ;; each item is in the format '(old . new) (let ((transforms '((pcomplete . completion)))) - (erc-delete-dups + (delete-dups (mapcar (lambda (m) (or (cdr (assoc m transforms)) m)) mods)))) @@ -2316,7 +2326,7 @@ and appears in face `erc-input-face' in the buffer." (setq result (concat result network-name " << " line "\n"))) result) - (erc-propertize + (propertize (concat network-name " >> " string (if (/= ?\n (aref string @@ -2339,7 +2349,7 @@ If ARG is non-nil, show the *erc-protocol* buffer." (interactive "P") (let* ((buf (get-buffer-create "*erc-protocol*"))) (with-current-buffer buf - (erc-view-mode-enter) + (view-mode-enter) (when (null (current-local-map)) (let ((inhibit-read-only t)) (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n")) @@ -2677,7 +2687,7 @@ displayed hostnames." otherwise `erc-server-announced-name'. SERVER is matched against `erc-common-server-suffixes'." (when server - (or (cdar (erc-remove-if-not + (or (cdar (cl-remove-if-not (lambda (net) (string-match (car net) server)) erc-common-server-suffixes)) erc-server-announced-name))) @@ -2773,7 +2783,7 @@ See also `erc-server-send'." (defun erc-get-arglist (fun) "Return the argument list of a function without the parens." - (let ((arglist (format "%S" (erc-function-arglist fun)))) + (let ((arglist (format "%S" (help-function-arglist fun)))) (if (string-match "\\`(\\(.*\\))\\'" arglist) (match-string 1 arglist) arglist))) @@ -3153,16 +3163,18 @@ were most recently invited. See also `invitation'." (setq chnl (erc-ensure-channel-name channel))) (when chnl ;; Prevent double joining of same channel on same server. - (let ((joined-channels - (mapcar #'(lambda (chanbuf) - (with-current-buffer chanbuf (erc-default-target))) - (erc-channel-list erc-server-process)))) - (if (erc-member-ignore-case chnl joined-channels) - (switch-to-buffer (car (erc-member-ignore-case chnl - joined-channels))) - (let ((server (with-current-buffer (process-buffer erc-server-process) - (or erc-session-server erc-server-announced-name)))) - (erc-server-join-channel server chnl key)))))) + (let* ((joined-channels + (mapcar #'(lambda (chanbuf) + (with-current-buffer chanbuf (erc-default-target))) + (erc-channel-list erc-server-process))) + (server (with-current-buffer (process-buffer erc-server-process) + (or erc-session-server erc-server-announced-name))) + (chnl-name (car (erc-member-ignore-case chnl joined-channels)))) + (if chnl-name + (switch-to-buffer (if (get-buffer chnl-name) + chnl-name + (concat chnl-name "/" server))) + (erc-server-join-channel server chnl key))))) t) (defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN) @@ -3558,7 +3570,7 @@ If S is non-nil, it will be used as the quit reason." If S is non-nil, it will be used as the quit reason." (or s (if (fboundp 'yow) - (erc-replace-regexp-in-string "\n" "" (yow)) + (replace-regexp-in-string "\n" "" (yow)) (erc-quit/part-reason-default)))) (make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4") @@ -3585,7 +3597,7 @@ If S is non-nil, it will be used as the part reason." If S is non-nil, it will be used as the quit reason." (or s (if (fboundp 'yow) - (erc-replace-regexp-in-string "\n" "" (yow)) + (replace-regexp-in-string "\n" "" (yow)) (erc-quit/part-reason-default)))) (make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4") @@ -3712,8 +3724,9 @@ the message given by REASON." x-toolkit-scroll-bars))) "") (if (featurep 'multi-tty) ", multi-tty" "")) - (if erc-emacs-build-time - (concat " of " erc-emacs-build-time) + (if emacs-build-time + (concat " of " (format-time-string + "%Y-%m-%d" emacs-build-time)) ""))) t) @@ -4001,13 +4014,13 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, ;; Do not extend the text properties when typing at the end ;; of the prompt, but stuff typed in front of the prompt ;; shall remain part of the prompt. - (setq prompt (erc-propertize prompt - 'start-open t ; XEmacs - 'rear-nonsticky t ; Emacs - 'erc-prompt t - 'field t - 'front-sticky t - 'read-only t)) + (setq prompt (propertize prompt + 'start-open t ; XEmacs + 'rear-nonsticky t ; Emacs + 'erc-prompt t + 'field t + 'front-sticky t + 'read-only t)) (erc-put-text-property 0 (1- (length prompt)) 'font-lock-face (or face 'erc-prompt-face) prompt) @@ -4390,15 +4403,15 @@ See also `erc-format-nick-function'." (defun erc-get-user-mode-prefix (user) (when user (cond ((erc-channel-user-owner-p user) - (erc-propertize "~" 'help-echo "owner")) + (propertize "~" 'help-echo "owner")) ((erc-channel-user-admin-p user) - (erc-propertize "&" 'help-echo "admin")) + (propertize "&" 'help-echo "admin")) ((erc-channel-user-op-p user) - (erc-propertize "@" 'help-echo "operator")) + (propertize "@" 'help-echo "operator")) ((erc-channel-user-halfop-p user) - (erc-propertize "%" 'help-echo "half-op")) + (propertize "%" 'help-echo "half-op")) ((erc-channel-user-voice-p user) - (erc-propertize "+" 'help-echo "voice")) + (propertize "+" 'help-echo "voice")) (t "")))) (defun erc-format-@nick (&optional user _channel-data) @@ -4409,7 +4422,7 @@ prefix. Use CHANNEL-DATA to determine op and voice status. See also `erc-format-nick-function'." (when user (let ((nick (erc-server-user-nickname user))) - (concat (erc-propertize + (concat (propertize (erc-get-user-mode-prefix nick) 'font-lock-face 'erc-nick-prefix-face) nick)))) @@ -4422,12 +4435,12 @@ also `erc-format-nick-function'." (nick (erc-current-nick)) (mode (erc-get-user-mode-prefix nick))) (concat - (erc-propertize open 'font-lock-face 'erc-default-face) - (erc-propertize mode 'font-lock-face 'erc-my-nick-prefix-face) - (erc-propertize nick 'font-lock-face 'erc-my-nick-face) - (erc-propertize close 'font-lock-face 'erc-default-face))) + (propertize open 'font-lock-face 'erc-default-face) + (propertize mode 'font-lock-face 'erc-my-nick-prefix-face) + (propertize nick 'font-lock-face 'erc-my-nick-face) + (propertize close 'font-lock-face 'erc-default-face))) (let ((prefix "> ")) - (erc-propertize prefix 'font-lock-face 'erc-default-face)))) + (propertize prefix 'font-lock-face 'erc-default-face)))) (defun erc-echo-notice-in-default-buffer (s parsed buffer _sender) "Echos a private notice in the default buffer, namely the @@ -4560,7 +4573,7 @@ See also: `erc-echo-notice-in-user-buffers', ((string-match "^-" mode) ;; Remove the unbanned masks from the ban list (setq erc-channel-banlist - (erc-delete-if + (cl-delete-if #'(lambda (y) (member (upcase (cdr y)) (mapcar #'upcase @@ -4581,7 +4594,7 @@ See also: `erc-echo-notice-in-user-buffers', "Group LIST into sublists of length N." (cond ((null list) nil) ((null (nthcdr n list)) (list list)) - (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n))))) + (t (cons (cl-subseq list 0 n) (erc-group-list (nthcdr n list) n))))) ;;; MOTD numreplies @@ -6170,8 +6183,7 @@ non-nil value is found. output (apply #'format format-args)) ;; Change all "1 units" to "1 unit". (while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output) - (setq output (erc-replace-match-subexpression-in-string - "" output (match-string 2 output) 2 (match-beginning 2)))) + (setq output (replace-match "" nil nil output 2))) output)) @@ -6489,16 +6501,16 @@ if `erc-away' is non-nil." (fill-region (point-min) (point-max)) (buffer-string)))) (setq header-line-format - (erc-replace-regexp-in-string + (replace-regexp-in-string "%" "%%" (if face - (erc-propertize header 'help-echo help-echo - 'face face) - (erc-propertize header 'help-echo help-echo)))))) + (propertize header 'help-echo help-echo + 'face face) + (propertize header 'help-echo help-echo)))))) (t (setq header-line-format (if face - (erc-propertize header 'face face) + (propertize header 'face face) header))))))) (force-mode-line-update))) @@ -6765,7 +6777,7 @@ functions." nick user host channel (if (not (string= reason "")) (format ": %s" - (erc-replace-regexp-in-string "%" "%%" reason)) + (replace-regexp-in-string "%" "%%" reason)) ""))))) diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index bf5a4bf1afe..7991c631772 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -114,7 +114,6 @@ This is default behavior of shells like bash." backward-list forward-page backward-page - forward-point forward-paragraph backward-paragraph backward-prefix-chars diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 0aa4ec4d16c..b4154861908 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -382,12 +382,7 @@ it defaults to `insert'." "Set handle INDEX, using MODE, to point to TARGET." (when target (if (and (stringp target) - (or (cond - ((boundp 'null-device) - (string= target null-device)) - ((boundp 'grep-null-device) - (string= target grep-null-device)) - (t nil)) + (or (string= target null-device) (string= target "/dev/null"))) (aset eshell-current-handles index nil) (let ((where (eshell-get-target target mode)) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index d0147b345aa..8799007c596 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -690,46 +690,47 @@ newline." "Send the output from PROCESS (STRING) to the interactive display. This is done after all necessary filtering has been done." (let ((oprocbuf (if process (process-buffer process) - (current-buffer))) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t)) - (let ((functions eshell-preoutput-filter-functions)) - (while (and functions string) - (setq string (funcall (car functions) string)) - (setq functions (cdr functions)))) - (if (and string oprocbuf (buffer-name oprocbuf)) - (let (opoint obeg oend) - (with-current-buffer oprocbuf - (setq opoint (point)) - (setq obeg (point-min)) - (setq oend (point-max)) - (let ((buffer-read-only nil) - (nchars (length string)) - (ostart nil)) - (widen) - (goto-char eshell-last-output-end) - (setq ostart (point)) - (if (<= (point) opoint) - (setq opoint (+ opoint nchars))) - (if (< (point) obeg) - (setq obeg (+ obeg nchars))) - (if (<= (point) oend) - (setq oend (+ oend nchars))) + (current-buffer))) + (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t)) + (when (and string oprocbuf (buffer-name oprocbuf)) + (with-current-buffer oprocbuf + (let ((functions eshell-preoutput-filter-functions)) + (while (and functions string) + (setq string (funcall (car functions) string)) + (setq functions (cdr functions)))) + (when string + (let (opoint obeg oend) + (setq opoint (point)) + (setq obeg (point-min)) + (setq oend (point-max)) + (let ((buffer-read-only nil) + (nchars (length string)) + (ostart nil)) + (widen) + (goto-char eshell-last-output-end) + (setq ostart (point)) + (if (<= (point) opoint) + (setq opoint (+ opoint nchars))) + (if (< (point) obeg) + (setq obeg (+ obeg nchars))) + (if (<= (point) oend) + (setq oend (+ oend nchars))) ;; Let the ansi-color overlay hooks run. (let ((inhibit-modification-hooks nil)) (insert-before-markers string)) - (if (= (window-start) (point)) - (set-window-start (selected-window) - (- (point) nchars))) - (if (= (point) eshell-last-input-end) - (set-marker eshell-last-input-end - (- eshell-last-input-end nchars))) - (set-marker eshell-last-output-start ostart) - (set-marker eshell-last-output-end (point)) - (force-mode-line-update)) - (narrow-to-region obeg oend) - (goto-char opoint) - (eshell-run-output-filters)))))) + (if (= (window-start) (point)) + (set-window-start (selected-window) + (- (point) nchars))) + (if (= (point) eshell-last-input-end) + (set-marker eshell-last-input-end + (- eshell-last-input-end nchars))) + (set-marker eshell-last-output-start ostart) + (set-marker eshell-last-output-end (point)) + (force-mode-line-update)) + (narrow-to-region obeg oend) + (goto-char opoint) + (eshell-run-output-filters))))))) (defun eshell-run-output-filters () "Run the `eshell-output-filter-functions' on the current output." diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index d2c17fe1f77..db1b258c8f5 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -295,7 +295,7 @@ See `eshell-needs-pipe'." (process-environment (eshell-environment-variables)) proc decoding encoding changed) (cond - ((fboundp 'start-file-process) + ((fboundp 'make-process) (setq proc (let ((process-connection-type (unless (eshell-needs-pipe-p command) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 5ffb159b575..6698ca45de4 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -384,15 +384,6 @@ corresponding to a successful execution." (set status-var eshell-last-command-status)) (cadr result)))))) -;;;_* Reporting bugs -;; -;; If you do encounter a bug, on any system, please report -;; it -- in addition to any particular oddities in your configuration -;; -- so that the problem may be corrected for the benefit of others. - -;;;###autoload -(define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1") - ;;; Code: (defun eshell-unload-all-modules () diff --git a/lisp/ffap.el b/lisp/ffap.el index ceba9d26223..28f566dd93a 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1109,6 +1109,121 @@ The arguments CHARS, BEG and END are handled as described in ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95. "Last string returned by the function `ffap-string-at-point'.") +(defcustom ffap-file-name-with-spaces nil + "If non-nil, enable looking for paths with spaces in `ffap-string-at-point'. +Enabling this variable may lead to `find-file-at-point' guessing +wrong more often when trying to find a file name intermingled +with normal text, but can be useful when working on systems that +normally use spaces in file names (like Microsoft Windows and the +like)." + :type 'boolean + :version "28.1") + +(defun ffap-search-backward-file-end (&optional dir-separator end) + "Search backward position point where file would probably end. +Optional DIR-SEPARATOR defaults to \"/\". The search maximum is +`line-end-position' or optional END point. + +Suppose the cursor is somewhere that might be near end of file, +the guessing would position point before punctuation (like comma) +after the file extension: + + C:\temp\file.log, which contain .... + =============================== (before) + ---------------- (after) + + + C:\temp\file.log on Windows or /tmp/file.log on Unix + =============================== (before) + ---------------- (after) + +The strategy is to search backward until DIR-SEPARATOR which defaults to +\"/\" and then take educated guesses. + +Move point and return point if an adjustment was done." + (unless dir-separator + (setq dir-separator "/")) + (let ((opoint (point)) + point punct end whitespace-p) + (when (re-search-backward + (regexp-quote dir-separator) (line-beginning-position) t) + ;; Move to the beginning of the match.. + (forward-char 1) + ;; ... until typical punctuation. + (when (re-search-forward "\\([][<>()\"'`,.:;]\\)" + (or end + (line-end-position)) + t) + (setq end (match-end 0)) + (setq punct (match-string 1)) + (setq whitespace-p (looking-at "[ \t\r\n]\\|$")) + (goto-char end) + (cond + ((and (string-equal punct ".") + whitespace-p) ;end of sentence + (setq point (1- (point)))) + ((and (string-equal punct ".") + (looking-at "[a-zA-Z0-9.]+")) ;possibly file extension + (setq point (match-end 0))) + (t + (setq point (point))))) + (goto-char opoint) + (when point + (goto-char point) + point)))) + +(defun ffap-search-forward-file-end (&optional dir-separator) + "Search DIR-SEPARATOR and position point at file's maximum ending. +This includes spaces. +Optional DIR-SEPARATOR defaults to \"/\". +Call `ffap-search-backward-file-end' to refine the ending point." + (unless dir-separator + (setq dir-separator "/")) + (let* ((chars ;expected chars in file name + (concat "[^][^<>()\"'`;,#*|" + ;; exclude the opposite as we know the separator + (if (string-equal dir-separator "/") + "\\\\" + "/") + "\t\r\n]")) + (re (concat + chars "*" + (if dir-separator + (regexp-quote dir-separator) + "/") + chars "*"))) + (when (looking-at re) + (goto-char (match-end 0))))) + +(defun ffap-dir-separator-near-point () + "Search backward and forward for closest slash or backlash in line. +Return string slash or backslash. Point is moved to closest position." + (let ((point (point)) + str pos) + (when (looking-at ".*?/") + (setq str "/" + pos (match-end 0))) + (when (and (looking-at ".*?\\\\") + (or (null pos) + (< (match-end 0) pos))) + (setq str "\\" + pos (match-end 0))) + (goto-char point) + (when (and (re-search-backward "/" (line-beginning-position) t) + (or (null pos) + (< (- point (point)) (- pos point)))) + (setq str "/" + pos (1+ (point)))) ;1+ to keep cursor at the end of char + (goto-char point) + (when (and (re-search-backward "\\\\" (line-beginning-position) t) + (or (null pos) + (< (- point (point)) (- pos point)))) + (setq str "\\" + pos (1+ (point)))) + (when pos + (goto-char pos)) + str)) + (defun ffap-string-at-point (&optional mode) "Return a string of characters from around point. @@ -1128,7 +1243,8 @@ Set the variables `ffap-string-at-point' and When the region is active and larger than `ffap-max-region-length', return an empty string, and set `ffap-string-at-point-region' to '(1 1)." - (let* ((args + (let* (dir-separator + (args (cdr (or (assq (or mode major-mode) ffap-string-at-point-mode-alist) (assq 'file ffap-string-at-point-mode-alist)))) @@ -1137,14 +1253,25 @@ return an empty string, and set `ffap-string-at-point-region' to '(1 1)." (beg (if region-selected (region-beginning) (save-excursion - (skip-chars-backward (car args)) - (skip-chars-forward (nth 1 args) pt) + (if (and ffap-file-name-with-spaces + (memq mode '(nil file))) + (when (setq dir-separator (ffap-dir-separator-near-point)) + (while (re-search-backward + (regexp-quote dir-separator) + (line-beginning-position) t) + (goto-char (match-beginning 0)))) + (skip-chars-backward (car args)) + (skip-chars-forward (nth 1 args) pt)) (point)))) (end (if region-selected (region-end) (save-excursion (skip-chars-forward (car args)) (skip-chars-backward (nth 2 args) pt) + (when (and ffap-file-name-with-spaces + (memq mode '(nil file))) + (ffap-search-forward-file-end dir-separator) + (ffap-search-backward-file-end dir-separator)) (point)))) (region-len (- (max beg end) (min beg end)))) @@ -1825,12 +1952,6 @@ Only intended for interactive use." (defalias 'find-file-literally-at-point 'ffap-literally) -;;; Bug Reporter: - -(define-obsolete-function-alias 'ffap-bug 'report-emacs-bug "23.1") -(define-obsolete-function-alias 'ffap-submit-bug 'report-emacs-bug "23.1") - - ;;; Hooks for Gnus, VM, Rmail: ;; ;; If you do not like these bindings, write versions with whatever diff --git a/lisp/files.el b/lisp/files.el index 742fd78df1d..f92c3793b00 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -752,10 +752,16 @@ resulting list of directory names. For an empty path element (i.e., a leading or trailing separator, or two adjacent separators), return nil (meaning `default-directory') as the associated list element." (when (stringp search-path) - (mapcar (lambda (f) - (if (equal "" f) nil - (substitute-in-file-name (file-name-as-directory f)))) - (split-string search-path path-separator)))) + (let ((spath (substitute-env-vars search-path))) + (mapcar (lambda (f) + (if (equal "" f) nil + (let ((dir (expand-file-name (file-name-as-directory f)))) + ;; Previous implementation used `substitute-in-file-name' + ;; which collapse multiple "/" in front. Do the same for + ;; backward compatibility. + (if (string-match "\\`/+" dir) + (substring dir (1- (match-end 0))) dir)))) + (split-string spath path-separator))))) (defun cd-absolute (dir) "Change current directory to given absolute file name DIR." @@ -979,14 +985,6 @@ one or more of those symbols." (completion-table-with-context string-dir names string-file pred action))))) -(defun locate-file-completion (string path-and-suffixes action) - "Do completion for file names passed to `locate-file'. -PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." - (declare (obsolete locate-file-completion-table "23.1")) - (locate-file-completion-table (car path-and-suffixes) - (cdr path-and-suffixes) - string nil action)) - (defvar locate-dominating-stop-dir-regexp (purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'") "Regexp of directory names that stop the search in `locate-dominating-file'. @@ -2683,8 +2681,6 @@ since only a single case-insensitive search through the alist is made." ("\\.p\\'" . pascal-mode) ("\\.pas\\'" . pascal-mode) ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode) - ("\\.ad[abs]\\'" . ada-mode) - ("\\.ad[bs]\\.dg\\'" . ada-mode) ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) ("Imakefile\\'" . makefile-imake-mode) ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 5cda4a693db..c633877e640 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -51,7 +51,7 @@ ;; also the variable `font-lock-maximum-size'. Support modes for Font Lock ;; mode can be used to speed up Font Lock mode. See `font-lock-support-mode'. -;;; How Font Lock mode fontifies: +;;;; How Font Lock mode fontifies: ;; When Font Lock mode is turned on in a buffer, it (a) fontifies the entire ;; buffer and (b) installs one of its fontification functions on one of the @@ -96,7 +96,7 @@ ;; some syntactic parsers for common languages and a son-of-font-lock.el could ;; use them rather then relying so heavily on the keyword (regexp) pass. -;;; How Font Lock mode supports modes or is supported by modes: +;;;; How Font Lock mode supports modes or is supported by modes: ;; Modes that support Font Lock mode do so by defining one or more variables ;; whose values specify the fontification. Font Lock mode knows of these @@ -112,7 +112,7 @@ ;; Font Lock mode fontification behavior can be modified in a number of ways. ;; See the below comments and the comments distributed throughout this file. -;;; Constructing patterns: +;;;; Constructing patterns: ;; See the documentation for the variable `font-lock-keywords'. ;; @@ -120,7 +120,7 @@ ;; `font-lock-syntactic-keywords' can be generated via the function ;; `regexp-opt'. -;;; Adding patterns for modes that already support Font Lock: +;;;; Adding patterns for modes that already support Font Lock: ;; Though Font Lock highlighting patterns already exist for many modes, it's ;; likely there's something that you want fontified that currently isn't, even @@ -135,7 +135,7 @@ ;; other variables. For example, additional C types can be specified via the ;; variable `c-font-lock-extra-types'. -;;; Adding patterns for modes that do not support Font Lock: +;;;; Adding patterns for modes that do not support Font Lock: ;; Not all modes support Font Lock mode. If you (as a user of the mode) add ;; patterns for a new mode, you must define in your ~/.emacs a variable or @@ -155,7 +155,7 @@ ;; (set (make-local-variable 'font-lock-defaults) ;; '(foo-font-lock-keywords t)))) -;;; Adding Font Lock support for modes: +;;;; Adding Font Lock support for modes: ;; Of course, it would be better that the mode already supports Font Lock mode. ;; The package author would do something similar to above. The mode must @@ -986,7 +986,7 @@ The value of this variable is used when Font Lock mode is turned on." ((bound-and-true-p lazy-lock-mode) (lazy-lock-after-unfontify-buffer)))) -;;; End of Font Lock Support mode. +;; End of Font Lock Support mode. ;;; Fontification functions. @@ -1393,7 +1393,7 @@ delimit the region to fontify." (font-lock-fontify-region (point) (mark))) ((error quit) (message "Fontifying block...%s" error-data))))))) -;;; End of Fontification functions. +;; End of Fontification functions. ;;; Additional text property functions. @@ -1485,7 +1485,7 @@ Optional argument OBJECT is the string or buffer containing the text." (put-text-property start next prop new object)))))) (setq start (text-property-not-all next end prop nil object))))) -;;; End of Additional text property functions. +;; End of Additional text property functions. ;;; Syntactic regexp fontification functions. @@ -1591,7 +1591,7 @@ START should be at the beginning of a line." (setq highlights (cdr highlights)))) (setq keywords (cdr keywords))))) -;;; End of Syntactic regexp fontification functions. +;; End of Syntactic regexp fontification functions. ;;; Syntactic fontification functions. @@ -1650,7 +1650,7 @@ START should be at the beginning of a line." (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table)))))) -;;; End of Syntactic fontification functions. +;; End of Syntactic fontification functions. ;;; Keyword regexp fontification functions. @@ -1784,9 +1784,9 @@ LOUDLY, if non-nil, allows progress-meter bar." (setq keywords (cdr keywords))) (set-marker pos nil))) -;;; End of Keyword regexp fontification functions. +;; End of Keyword regexp fontification functions. -;; Various functions. +;;; Various functions. (defun font-lock-compile-keywords (keywords &optional syntactic-keywords) "Compile KEYWORDS into the form (t KEYWORDS COMPILED...) @@ -2102,7 +2102,7 @@ Sets various variables using `font-lock-defaults' and "Font Lock mode face used to highlight grouping constructs in Lisp regexps." :group 'font-lock-faces) -;;; End of Color etc. support. +;; End of Color etc. support. ;;; Menu support. @@ -2204,7 +2204,7 @@ Sets various variables using `font-lock-defaults' and ;; ;; Deactivate less/more fontification entries. ;; (setq font-lock-fontify-level nil)) -;;; End of Menu support. +;; End of Menu support. ;;; Various regexp information shared by several modes. ;; ;; Information specific to a single mode should go in its load library. diff --git a/lisp/forms.el b/lisp/forms.el index fcb6075f94b..83daabdcd6e 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -504,12 +504,9 @@ Commands: Equivalent keys in read-only mode: (setq forms-new-record-filter nil) (setq forms-modified-record-filter nil) - ;; If running Emacs 19 under X, setup faces to show read-only and - ;; read-write fields. - (if (fboundp 'make-face) - (progn - (make-local-variable 'forms-ro-face) - (make-local-variable 'forms-rw-face))) + ;; Setup faces to show read-only and read-write fields. + (make-local-variable 'forms-ro-face) + (make-local-variable 'forms-rw-face) ;; eval the buffer, should set variables ;;(message "forms: processing control file...") @@ -609,16 +606,14 @@ Commands: Equivalent keys in read-only mode: (setq forms--mode-setup t) ;; Copy desired faces to the actual variables used by the forms formatter. - (if (fboundp 'make-face) + (make-local-variable 'forms--ro-face) + (make-local-variable 'forms--rw-face) + (if forms-read-only (progn - (make-local-variable 'forms--ro-face) - (make-local-variable 'forms--rw-face) - (if forms-read-only - (progn - (setq forms--ro-face forms-ro-face) - (setq forms--rw-face forms-ro-face)) - (setq forms--ro-face forms-ro-face) - (setq forms--rw-face forms-rw-face)))) + (setq forms--ro-face forms-ro-face) + (setq forms--rw-face forms-ro-face)) + (setq forms--ro-face forms-ro-face) + (setq forms--rw-face forms-rw-face)) ;; Make more local variables. (make-local-variable 'forms--file-buffer) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 1be8c48bcfc..e0339cc1f32 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5849,7 +5849,10 @@ all parts." (concat "; " gnus-tmp-name)))) (unless (equal gnus-tmp-description "") (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) - (when (zerop gnus-tmp-length) + (when (and (zerop gnus-tmp-length) + ;; Only nnimap supports partial fetches so far. + nnimap-fetch-partial-articles + (string-match "^nnimap\\+" gnus-newsgroup-name)) (setq gnus-tmp-type-long (concat gnus-tmp-type-long diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 719498a0337..c53f81fe026 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1913,7 +1913,8 @@ increase the score of each group you read." "," gnus-summary-best-unread-article "[" gnus-summary-prev-unseen-article "]" gnus-summary-next-unseen-article - "\M-s" gnus-summary-search-article-forward + "\M-s\M-s" gnus-summary-search-article-forward + "\M-s\M-r" gnus-summary-search-article-backward "\M-r" gnus-summary-search-article-backward "\M-S" gnus-summary-repeat-search-article-forward "\M-R" gnus-summary-repeat-search-article-backward @@ -12284,7 +12285,7 @@ no matter what the properties `:decode' and `:headers' are." (interactive (gnus-interactive "P\ny")) (require 'gnus-art) (let* ((articles (gnus-summary-work-articles n)) - (result-buffer "*Shell Command Output*") + (result-buffer shell-command-buffer-name) (all-headers (not (memq sym '(nil r)))) (gnus-save-all-headers (or all-headers gnus-save-all-headers)) (raw (eq sym 'r)) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index abe546b8cb6..4876715ae6a 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -455,9 +455,7 @@ displayed in the echo area." (> message-log-max 0) (/= (length str) 0)) (setq time (current-time)) - (with-current-buffer (if (fboundp 'messages-buffer) - (messages-buffer) - (get-buffer-create "*Messages*")) + (with-current-buffer (messages-buffer) (goto-char (point-max)) (let ((inhibit-read-only t)) (insert ,timestamp str "\n") diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 36b28350362..baa3146e64e 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -142,7 +142,7 @@ used to display Gnus windows." (pipe (vertical 1.0 (summary 0.25 point) - ("*Shell Command Output*" 1.0))) + (shell-command-buffer-name 1.0))) (bug (vertical 1.0 (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 68e2ce772c2..cecf4d4fb49 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1029,8 +1029,7 @@ Check the NNTPSERVER environment variable and the ;; `M-x customize-variable RET gnus-select-method RET' should work without ;; starting or even loading Gnus. -;;;###autoload(when (fboundp 'custom-autoload) -;;;###autoload (custom-autoload 'gnus-select-method "gnus")) +;;;###autoload(custom-autoload 'gnus-select-method "gnus") (defcustom gnus-select-method (list 'nntp (or (gnus-getenv-nntpserver) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 819f3e41d3d..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) @@ -2737,6 +2738,67 @@ systematically send encrypted emails when possible." (when (message-all-epg-keys-available-p) (mml-secure-message-sign-encrypt))) +(defcustom message-openpgp-header nil + "Specification for the \"OpenPGP\" header of outgoing messages. + +The value must be a list of three elements, all strings: +- Key ID, in hexadecimal form; +- Key URL or ASCII armoured key; and +- Protection preference, one of: \"unprotected\", \"sign\", + \"encrypt\" or \"signencrypt\". + +Each of the elements may be nil, in which case its part in the +OpenPGP header will be left out. If all the values are nil, +or `message-openpgp-header' is itself nil, the OpenPGP header +will not be inserted." + :type '(choice + (const :tag "Don't add OpenPGP header" nil) + (list :tag "Use OpenPGP header" + (choice (string :tag "ID") + (const :tag "No ID" nil)) + (choice (string :tag "Key") + (const :tag "No Key" nil)) + (choice (other :tag "None" nil) + (const :tag "Unprotected" "unprotected") + (const :tag "Sign" "sign") + (const :tag "Encrypt" "encrypt") + (const :tag "Sign and Encrypt" "signencrypt")))) + :version "28.1") + +(defun message-add-openpgp-header () + "Add OpenPGP header to point to public key. + +Header will be constructed as specified in `message-openpgp-header'. + +Consider adding this function to `message-header-setup-hook'" + ;; See https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header + (when (and message-openpgp-header + (or (nth 0 message-openpgp-header) + (nth 1 message-openpgp-header) + (nth 2 message-openpgp-header))) + (message-add-header + (with-temp-buffer + (insert "OpenPGP: ") + ;; add ID + (let (need-sep) + (when (nth 0 message-openpgp-header) + (insert "id=" (nth 0 message-openpgp-header)) + (setq need-sep t)) + ;; add URL + (when (nth 1 message-openpgp-header) + (when need-sep (insert "; ")) + (if (string-match-p ";") + (insert "url=\"" (nth 1 message-openpgp-header) "\"") + (insert "url=\"" (nth 1 message-openpgp-header) "\"")) + (setq need-sep t)) + ;; add preference + (when (nth 2 message-openpgp-header) + (when need-sep (insert "; ")) + (insert "preference=" (nth 2 message-openpgp-header)))) + ;; insert header + (buffer-string))) + (message-sort-headers))) + ;;; @@ -4368,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 @@ -4404,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))) @@ -4425,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 @@ -4749,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))))) @@ -4783,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'. @@ -4801,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))) @@ -6435,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)) @@ -8752,15 +8827,14 @@ used to take the screenshot." ;;;###autoload (defun message-mailto () - "Function to be run to parse command line mailto: links. + "Command to parse command line mailto: links. This is meant to be used for MIME handlers: Setting the handler -for \"x-scheme-handler/mailto;\" to \"emacs -fn message-mailto %u\" +for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\" will then start up Emacs ready to compose mail." (interactive) ;; <a href="mailto:someone@example.com?subject=This%20is%20the%20subject&cc=someone_else@example.com&body=This%20is%20the%20body">Send email</a> (message-mail) - (message-mailto-1 (car command-line-args-left)) - (setq command-line-args-left (cdr command-line-args-left))) + (message-mailto-1 (pop command-line-args-left))) (defun message-mailto-1 (url) (let ((args (message-parse-mailto-url url))) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 7629d5cb151..282465722de 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -131,10 +131,6 @@ is not available." (cond ((null charset) charset) - ;; Running in a non-MULE environment. - ((or (null (mm-get-coding-system-list)) - (not (fboundp 'coding-system-get))) - charset) ;; Check override list quite early. Should only used for decoding, not for ;; encoding! ((and allow-override @@ -295,77 +291,16 @@ superset of iso-8859-1." (defvar mm-universal-coding-system mm-auto-save-coding-system "The universal coding system.") -;; Fixme: some of the cars here aren't valid MIME charsets. That -;; should only matter with XEmacs, though. (defvar mm-mime-mule-charset-alist - '((us-ascii ascii) - (iso-8859-1 latin-iso8859-1) - (iso-8859-2 latin-iso8859-2) - (iso-8859-3 latin-iso8859-3) - (iso-8859-4 latin-iso8859-4) - (iso-8859-5 cyrillic-iso8859-5) - ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters. - ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default - ;; charset is koi8-r, not iso-8859-5. - (koi8-r cyrillic-iso8859-5 gnus-koi8-r) - (iso-8859-6 arabic-iso8859-6) - (iso-8859-7 greek-iso8859-7) - (iso-8859-8 hebrew-iso8859-8) - (iso-8859-9 latin-iso8859-9) - (iso-8859-14 latin-iso8859-14) - (iso-8859-15 latin-iso8859-15) - (viscii vietnamese-viscii-lower) - (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) - (euc-kr korean-ksc5601) - (gb2312 chinese-gb2312) - (gbk chinese-gbk) - (gb18030 gb18030-2-byte - gb18030-4-byte-bmp gb18030-4-byte-smp - gb18030-4-byte-ext-1 gb18030-4-byte-ext-2) - (big5 chinese-big5-1 chinese-big5-2) - (tibetan tibetan) - (thai-tis620 thai-tis620) - (windows-1251 cyrillic-iso8859-5) - (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) - (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212) - (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2) - (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2 - cyrillic-iso8859-5 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2 - chinese-cns11643-3 chinese-cns11643-4 - chinese-cns11643-5 chinese-cns11643-6 - chinese-cns11643-7) - (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 - japanese-jisx0213-1 japanese-jisx0213-2) - (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) - (utf-8)) - "Alist of MIME-charset/MULE-charsets.") - -;; Correct by construction, but should be unnecessary for Emacs: -(when (and (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (let ((css (sort-coding-systems (coding-system-list 'base-only))) - cs mime mule alist) - (while css - (setq cs (pop css) - mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode) - (coding-system-get cs 'mime-charset))) + (let (mime mule alist) + (dolist (cs (sort-coding-systems (coding-system-list 'base-only))) + (setq mime (coding-system-get cs 'mime-charset)) (when (and mime - (not (eq t (setq mule - (coding-system-get cs 'safe-charsets)))) + (not (eq t (setq mule (coding-system-get cs 'safe-charsets)))) (not (assq mime alist))) (push (cons mime (delq 'ascii mule)) alist))) - (setq mm-mime-mule-charset-alist (nreverse alist)))) + (nreverse alist)) + "Alist of MIME-charset/MULE-charsets.") (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) "A list of special charsets. diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 4754f37a2da..acddb300339 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -329,7 +329,6 @@ Whether the passphrase is cached at all is controlled by (autoload 'epg-verify-string "epg") (autoload 'epg-sign-string "epg") (autoload 'epg-encrypt-string "epg") - (autoload 'epg-passphrase-callback-function "epg") (autoload 'epg-context-set-passphrase-callback "epg") (autoload 'epg-sub-key-fingerprint "epg") (autoload 'epg-configuration "epg-config") diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 8be1b84e52f..88864ea3579 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -242,7 +242,6 @@ Whether the passphrase is cached at all is controlled by (defvar epg-user-id-alist) (autoload 'epg-make-context "epg") -(autoload 'epg-passphrase-callback-function "epg") (autoload 'epa-select-keys "epa") (autoload 'epg-list-keys "epg") (autoload 'epg-context-set-armor "epg") diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index d1d150ad2ee..45c9bbfe905 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -712,7 +712,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (autoload 'epg-verify-string "epg") (autoload 'epg-sign-string "epg") (autoload 'epg-encrypt-string "epg") -(autoload 'epg-passphrase-callback-function "epg") (autoload 'epg-context-set-passphrase-callback "epg") (autoload 'epg-key-sub-key-list "epg") (autoload 'epg-sub-key-capability "epg") diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index d41f32801ee..5504a520783 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -56,14 +56,11 @@ (defvar smiley-data-directory) -(defcustom smiley-style - (if (and (fboundp 'face-attribute) - ;; In batch mode, attributes can be unspecified. - (condition-case nil - (>= (face-attribute 'default :height) 160) - (error nil))) - 'medium - 'low-color) +;; In batch mode, attributes can be unspecified. +(defcustom smiley-style (if (ignore-errors + (>= (face-attribute 'default :height) 160)) + 'medium + 'low-color) "Smiley style." :type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14 (const :tag "medium, ~10 colors" medium) ;; 16x16 diff --git a/lisp/help-fns.el b/lisp/help-fns.el index b9536470631..a137c504888 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -364,6 +364,7 @@ suitable file is found, return nil." (help-C-file-name type 'subr) 'C-source)) ((and (not file-name) (symbolp object) + (eq type 'defvar) (integerp (get object 'variable-documentation))) ;; A variable defined in C. The form is from `describe-variable'. (if (get-buffer " *DOC*") @@ -1769,6 +1770,50 @@ documentation for the major and minor modes of that buffer." ;; For the sake of IELM and maybe others nil) +;; Widgets. + +(defvar describe-widget-functions + '(button-describe widget-describe) + "A list of functions for `describe-widget' to call. +Each function should take one argument, a buffer position, and return +non-nil if it described a widget at that position.") + +;;;###autoload +(defun describe-widget (&optional pos) + "Display a buffer with information about a widget. +You can use this command to describe buttons (e.g., the links in a *Help* +buffer), editable fields of the customization buffers, etc. + +Interactively, click on a widget to describe it, or hit RET to describe the +widget at point. + +When called from Lisp, POS may be a buffer position or a mouse position list. + +Calls each function of the list `describe-widget-functions' in turn, until +one of them returns non-nil." + (interactive + (list + (let ((key + (read-key + "Click on a widget, or hit RET to describe the widget at point"))) + (cond ((eq key ?\C-m) (point)) + ((and (mouse-event-p key) + (eq (event-basic-type key) 'mouse-1) + (equal (event-modifiers key) '(click))) + (event-end key)) + ((eq key ?\C-g) (signal 'quit nil)) + (t (user-error "You didn't specify a widget")))))) + (let (buf) + ;; Allow describing a widget in a different window. + (when (posnp pos) + (setq buf (window-buffer (posn-window pos)) + pos (posn-point pos))) + (with-current-buffer (or buf (current-buffer)) + (unless (cl-some (lambda (fun) (when (fboundp fun) (funcall fun pos))) + describe-widget-functions) + (message "No widget found at that position"))))) + + ;;; Replacements for old lib-src/ programs. Don't seem especially useful. ;; Replaces lib-src/digest-doc.c. diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index a18310322ad..0ffe77d2763 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -237,17 +237,11 @@ Instead, each hi-lock command will cycle through the faces in "Human-readable lighters for `hi-lock-interactive-patterns'.") (put 'hi-lock-interactive-lighters 'permanent-local t) -(define-obsolete-variable-alias 'hi-lock-face-history - 'hi-lock-face-defaults "23.1") (defvar hi-lock-face-defaults '("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-salmon" "hi-aquamarine" "hi-black-b" "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb") "Default faces for hi-lock interactive functions.") -(define-obsolete-variable-alias 'hi-lock-regexp-history - 'regexp-history - "23.1") - (defvar hi-lock-file-patterns-prefix "Hi-lock" "String used to identify hi-lock patterns at the start of files.") @@ -812,7 +806,9 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search." (setq hi-lock-interactive-patterns (cdr hi-lock-interactive-patterns) hi-lock-interactive-lighters - (cdr hi-lock-interactive-lighters))))))))) + (cdr hi-lock-interactive-lighters)))) + (when (or (> search-start (point-min)) (< search-end (point-max))) + (message "Hi-lock added only in range %d-%d" search-start search-end))))))) (defun hi-lock-set-file-patterns (patterns) "Replace file patterns list with PATTERNS and refontify." diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 04a5ccd8d59..ae97bb008af 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -224,9 +224,6 @@ colors then use this, if you want fancier faces then set ;; When you invoke highlight-changes-mode, should highlight-changes-visible-mode ;; be on or off? -(define-obsolete-variable-alias 'highlight-changes-initial-state - 'highlight-changes-visibility-initial-state "23.1") - (defcustom highlight-changes-visibility-initial-state t "Controls whether changes are initially visible in Highlight Changes mode. @@ -236,13 +233,7 @@ When a buffer is in Highlight Changes mode the function :type 'boolean :group 'highlight-changes) -;; highlight-changes-global-initial-state has been removed - - - ;; These are the strings displayed in the mode-line for the minor mode: -(define-obsolete-variable-alias 'highlight-changes-active-string - 'highlight-changes-visible-string "23.1") (defcustom highlight-changes-visible-string " +Chg" "The string used when in Highlight Changes mode and changes are visible. @@ -252,9 +243,6 @@ a string with a leading space." (const :tag "None" nil)) :group 'highlight-changes) -(define-obsolete-variable-alias 'highlight-changes-passive-string - 'highlight-changes-invisible-string "23.1") - (defcustom highlight-changes-invisible-string " -Chg" "The string used when in Highlight Changes mode and changes are hidden. This should be set to nil if no indication is desired, or to @@ -957,10 +945,6 @@ changes are made, so \\[highlight-changes-next-change] and (define-globalized-minor-mode global-highlight-changes-mode highlight-changes-mode highlight-changes-mode-turn-on) -(define-obsolete-function-alias - 'global-highlight-changes - 'global-highlight-changes-mode "23.1") - (defun highlight-changes-mode-turn-on () "See if Highlight Changes mode should be turned on for this buffer. This is called when `global-highlight-changes-mode' is turned on." diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 6265537e885..4d653972c95 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -556,10 +556,7 @@ If a window system is unavailable, calls `hfy-fallback-color-values'." '(1 2 3)) ;;(message ">> %s" color) (if window-system - (if (fboundp 'color-values) - (color-values color) - ;;(message "[%S]" window-system) - (x-color-values color)) + (color-values color) ;; blarg - tty colors are no good - go fetch some X colors: (hfy-fallback-color-values color)))) (define-obsolete-function-alias 'hfy-colour-vals #'hfy-color-vals "27.1") diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index bfb9787a96d..c9ca1f87424 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -504,7 +504,7 @@ format. See `ibuffer-update-saved-filters-format' and (ibuffer-forward-line 0)) (defun ibuffer--maybe-erase-shell-cmd-output () - (let ((buf (get-buffer "*Shell Command Output*"))) + (let ((buf (get-buffer shell-command-buffer-name))) (when (and (buffer-live-p buf) (not shell-command-dont-erase-buffer) (not (zerop (buffer-size buf)))) @@ -517,7 +517,7 @@ format. See `ibuffer-update-saved-filters-format' and :opstring "Shell command executed on" :before (ibuffer--maybe-erase-shell-cmd-output) :modifier-p nil) - (let ((out-buf (get-buffer-create "*Shell Command Output*"))) + (let ((out-buf (get-buffer-create shell-command-buffer-name))) (with-current-buffer out-buf (goto-char (point-max))) (call-shell-region (point-min) (point-max) command nil out-buf))) @@ -542,7 +542,7 @@ format. See `ibuffer-update-saved-filters-format' and :modifier-p nil) (let ((file (and (not (buffer-modified-p)) buffer-file-name)) - (out-buf (get-buffer-create "*Shell Command Output*"))) + (out-buf (get-buffer-create shell-command-buffer-name))) (unless (and file (file-exists-p file)) (setq file (make-temp-file diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 3747ae3d281..8a68df876c1 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -75,7 +75,11 @@ everything preceding the ~/ is discarded so the interactive selection process starts again from the user's $HOME.") (defcustom icomplete-show-matches-on-no-input nil - "When non-nil, show completions when first prompting for input." + "When non-nil, show completions when first prompting for input. +This also means that if you traverse the list of completions with +commands like `C-.' and just hit `C-j' (enter) without typing any +characters, the match under point will be chosen instead of the +default." :type 'boolean :version "24.4") @@ -709,7 +713,10 @@ matches exist." (push comp prospects) (setq limit t)))) (setq prospects (nreverse prospects)) - ;; Decorate first of the prospects. + ;; Return the first match if the user hits enter. + (when icomplete-show-matches-on-no-input + (setq completion-content-when-empty (car prospects))) + ;; Decorate first of the prospects. (when prospects (let ((first (copy-sequence (pop prospects)))) (put-text-property 0 (length first) diff --git a/lisp/ido.el b/lisp/ido.el index e834916a6da..c83b700e656 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1523,8 +1523,10 @@ Removes badly formatted data and ignored directories." (remove-function read-file-name-function #'ido-read-file-name) (remove-function read-buffer-function #'ido-read-buffer) (when ido-everywhere - (add-function :override read-file-name-function #'ido-read-file-name) - (add-function :override read-buffer-function #'ido-read-buffer))) + (if (not ido-mode) + (ido-mode 'both) + (add-function :override read-file-name-function #'ido-read-file-name) + (add-function :override read-buffer-function #'ido-read-buffer)))) (defvar ido-minor-mode-map-entry nil) @@ -2216,7 +2218,10 @@ If cursor is not at the end of the user input, move to end of input." ((and ido-enable-virtual-buffers ido-virtual-buffers (setq filename (assoc buf ido-virtual-buffers))) - (ido-visit-buffer (find-file-noselect (cdr filename)) method t)) + (if (eq method 'kill) + (setq recentf-list + (delete (cdr filename) recentf-list)) + (ido-visit-buffer (find-file-noselect (cdr filename)) method t))) ((and (eq ido-create-new-buffer 'prompt) (null require-match) @@ -4073,6 +4078,7 @@ Record command in `command-history' if optional RECORD is non-nil." (setq buffer (buffer-name buffer))) (let (win newframe) (cond + ;; "Killing" of virtual buffers is handled in `ido-buffer-internal'. ((eq method 'kill) (if record (ido-record-command 'kill-buffer buffer)) diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el index d1091e57cb5..3543be6de91 100644 --- a/lisp/image/gravatar.el +++ b/lisp/image/gravatar.el @@ -39,6 +39,7 @@ "Whether to cache retrieved gravatars." :type 'boolean :group 'gravatar) +(make-obsolete-variable 'gravatar-automatic-caching nil "28.1") (defcustom gravatar-cache-ttl 2592000 "Time to live in seconds for gravatar cache entries. @@ -48,6 +49,7 @@ is retrieved anew. The default value is 30 days." ;; Restricted :type to number of seconds. :version "27.1" :group 'gravatar) +(make-obsolete-variable 'gravatar-cache-ttl nil "28.1") (defcustom gravatar-rating "g" "Most explicit Gravatar rating level to allow. @@ -156,18 +158,58 @@ to track whether you're reading a specific mail." (setq func (lambda (result) (cond - (result - (funcall callback (format "%s://%s/avatar" - (cdar records) result))) - ((> (length records) 1) - (pop records) + ((and + result ;there is a result + (let* ((data (mapcar (lambda (record) + (dns-get 'data (cdr record))) + (dns-get 'answers result))) + (priorities (mapcar (lambda (r) + (dns-get 'priority r)) + data)) + (max-priority (if priorities + (apply #'max priorities) + 0)) + (sum 0) top) + ;; Attempt to find all records with the same maximal + ;; priority, and calculate the sum of their weights. + (dolist (ent data) + (when (= max-priority (dns-get 'priority ent)) + (setq sum (+ sum (dns-get 'weight ent))) + (push ent top))) + ;; In case there is more than one maximal priority + ;; record, choose one at random, while taking the + ;; individual record weights into consideration. + (catch 'done + (dolist (ent top) + (when (and (or (= 0 sum) + (<= 0 (random sum) + (dns-get 'weight ent))) + ;; Ensure that port and domain data are + ;; valid. In case non of the results + ;; were valid, `catch' will evaluate to + ;; nil, and the next cond clause will be + ;; tested. + (<= 1 (dns-get 'port ent) 65535) + (string-match-p "\\`[-.0-9A-Za-z]+\\'" + (dns-get 'target ent))) + (funcall callback + (url-normalize-url + (format "%s://%s:%s/avatar" + (cdar records) + (dns-get 'target ent) + (dns-get 'port ent)))) + (throw 'done t)) + (setq sum (- sum (dns-get 'weight ent)))))))) + ((setq records (cdr records)) + ;; In case there are at least two methods. (dns-query-asynchronous (concat (caar records) "._tcp." domain) func 'SRV)) - (t + (t ;fallback (funcall callback "https://seccdn.libravatar.org/avatar"))))) (dns-query-asynchronous - (concat (caar records) "._tcp." domain) func 'SRV))))) + (concat (caar records) "._tcp." domain) + func 'SRV t))))) (defun gravatar-hash (mail-address) "Return the Gravatar hash for MAIL-ADDRESS." @@ -206,19 +248,50 @@ to track whether you're reading a specific mail." (search-forward "\n\n" nil t) (buffer-substring (point) (point-max))))) +(defvar gravatar--cache (make-hash-table :test 'equal) + "Cache for gravatars.") + ;;;###autoload (defun gravatar-retrieve (mail-address callback &optional cbargs) "Asynchronously retrieve a gravatar for MAIL-ADDRESS. When finished, call CALLBACK as (apply CALLBACK GRAVATAR CBARGS), where GRAVATAR is either an image descriptor, or the symbol `error' if the retrieval failed." - (gravatar-build-url - mail-address - (lambda (url) - (if (url-cache-expired url gravatar-cache-ttl) - (url-retrieve url #'gravatar-retrieved (list callback cbargs) t) - (with-current-buffer (url-fetch-from-cache url) - (gravatar-retrieved () callback cbargs)))))) + (let ((cached (gethash mail-address gravatar--cache))) + (gravatar--prune-cache) + (if cached + (apply callback (cdr cached) cbargs) + ;; Nothing in the cache, fetch it. + (gravatar-build-url + mail-address + (lambda (url) + (url-retrieve + url + (lambda (status) + (let* ((data (and (not (plist-get status :error)) + (gravatar-get-data))) + (image (and data (create-image data nil t)))) + ;; Store the image in the cache. + (when image + (setf (gethash mail-address gravatar--cache) + (cons (time-convert (current-time) 'integer) + image))) + (prog1 + (apply callback (if data image 'error) cbargs) + (kill-buffer)))) + nil t)))))) + +(defun gravatar--prune-cache () + (let ((expired nil) + (time (- (time-convert (current-time) 'integer) + ;; Twelve hours. + (* 12 60 60)))) + (maphash (lambda (key val) + (when (< (car val) time) + (push key expired))) + gravatar--cache) + (dolist (key expired) + (remhash key gravatar--cache)))) ;;;###autoload (defun gravatar-retrieve-synchronously (mail-address) @@ -229,10 +302,8 @@ retrieval failed." (gravatar-build-url mail-address (lambda (u) (setq url u))) (while (not url) (sleep-for 0.01)) - (with-current-buffer (if (url-cache-expired url gravatar-cache-ttl) - (url-retrieve-synchronously url t) - (url-fetch-from-cache url)) - (gravatar-retrieved () #'identity)))) + (with-current-buffer (url-retrieve-synchronously url t) + (gravatar-retrieved nil #'identity)))) (defun gravatar-retrieved (status cb &optional cbargs) "Handle Gravatar response data in current buffer. @@ -241,10 +312,6 @@ an image descriptor, or the symbol `error' on failure. This function is intended as a callback for `url-retrieve'." (let ((data (unless (plist-get status :error) (gravatar-get-data)))) - (and data ; Only cache on success. - url-current-object ; Only cache if not already cached. - gravatar-automatic-caching - (url-store-in-cache)) (prog1 (apply cb (if data (create-image data nil t) 'error) cbargs) (kill-buffer)))) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 7714a778fcb..5fe931dd9bb 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2968,11 +2968,6 @@ on encoding." ;; Doc said "obsolete" in 23.1, this statement only added in 24.1. (make-obsolete 'unify-8859-on-decoding-mode "don't use it." "23.1") -(defvar nonascii-insert-offset 0) -(make-obsolete-variable 'nonascii-insert-offset "do not use it." "23.1") -(defvar nonascii-translation-table nil) -(make-obsolete-variable 'nonascii-translation-table "do not use it." "23.1") - (defvar ucs-names nil "Hash table of cached CHAR-NAME keys to CHAR-CODE values.") diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 80e78ef7877..b13bde58ca1 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -200,10 +200,6 @@ Character sets for defining other charsets, or for backward compatibility ;;; (charset-iso-graphic-plane charset) (charset-description charset))))) -(defvar non-iso-charset-alist nil - "Obsolete.") -(make-obsolete-variable 'non-iso-charset-alist "no longer relevant." "23.1") - ;; A variable to hold charset input history. (defvar charset-history nil) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 5cc10b1315a..660ac58e022 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -275,15 +275,6 @@ operations such as `find-coding-systems-region'." (put 'with-coding-priority 'edebug-form-spec t) ;;;###autoload -(defmacro detect-coding-with-priority (from to priority-list) - "Detect a coding system of the text between FROM and TO with PRIORITY-LIST. -PRIORITY-LIST is an alist of coding categories vs the corresponding -coding systems ordered by priority." - (declare (obsolete with-coding-priority "23.1")) - `(with-coding-priority (mapcar #'cdr ,priority-list) - (detect-coding-region ,from ,to))) - -;;;###autoload (defun detect-coding-with-language-environment (from to lang-env) "Detect a coding system for the text between FROM and TO with LANG-ENV. The detection takes into account the coding system priorities for the diff --git a/lisp/international/mule.el b/lisp/international/mule.el index df71205d515..092abc09b05 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -408,16 +408,6 @@ PLIST (property list) may contain any type of information a user ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. -(defun charset-id (_charset) - "Always return 0. This is provided for backward compatibility." - (declare (obsolete nil "23.1")) - 0) - -(defmacro charset-bytes (_charset) - "Always return 0. This is provided for backward compatibility." - (declare (obsolete nil "23.1")) - 0) - (defun get-charset-property (charset propname) "Return the value of CHARSET's PROPNAME property. This is the last value stored with @@ -463,19 +453,8 @@ Return -1 if charset isn't an ISO 2022 one." "Return long name of CHARSET." (plist-get (charset-plist charset) :long-name)) -(defun charset-list () - "Return list of all charsets ever defined." - (declare (obsolete charset-list "23.1")) - charset-list) - ;;; CHARACTER -(define-obsolete-function-alias 'char-valid-p 'characterp "23.1") - -(defun generic-char-p (_char) - "Always return nil. This is provided for backward compatibility." - (declare (obsolete nil "23.1")) - nil) (defun make-char-internal (charset-id &optional code1 code2) (let ((charset (aref emacs-mule-charset-table charset-id))) @@ -1085,14 +1064,11 @@ formats (e.g. iso-latin-1-unix, koi8-r-dos)." (setq codings (cons alias codings)))))) codings)) -(defconst char-coding-system-table nil - "It exists just for backward compatibility, and the value is always nil.") -(make-obsolete-variable 'char-coding-system-table nil "23.1") - (defun transform-make-coding-system-args (name type &optional doc-string props) "For internal use only. Transform XEmacs style args for `make-coding-system' to Emacs style. Value is a list of transformed arguments." + (declare (obsolete nil "28.1")) (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?"))) (eol-type (plist-get props 'eol-type)) properties tmp) @@ -1170,106 +1146,6 @@ Value is a list of transformed arguments." (error "unsupported XEmacs style make-coding-style arguments: %S" `(,name ,type ,doc-string ,props)))))) -(defun make-coding-system (coding-system type mnemonic doc-string - &optional - flags - properties - eol-type) - "Define a new coding system CODING-SYSTEM (symbol). -This function is provided for backward compatibility." - (declare (obsolete define-coding-system "23.1")) - ;; For compatibility with XEmacs, we check the type of TYPE. If it - ;; is a symbol, perhaps, this function is called with XEmacs-style - ;; arguments. Here, try to transform that kind of arguments to - ;; Emacs style. - (if (symbolp type) - (let ((args (transform-make-coding-system-args coding-system type - mnemonic doc-string))) - (setq coding-system (car args) - type (nth 1 args) - mnemonic (nth 2 args) - doc-string (nth 3 args) - flags (nth 4 args) - properties (nth 5 args) - eol-type (nth 6 args)))) - - (setq type - (cond ((eq type 0) 'emacs-mule) - ((eq type 1) 'shift-jis) - ((eq type 2) 'iso2022) - ((eq type 3) 'big5) - ((eq type 4) 'ccl) - ((eq type 5) 'raw-text) - (t - (error "Invalid coding system type: %s" type)))) - - (setq properties - (let ((plist nil) key) - (dolist (elt properties) - (setq key (car elt)) - (cond ((eq key 'post-read-conversion) - (setq key :post-read-conversion)) - ((eq key 'pre-write-conversion) - (setq key :pre-write-conversion)) - ((eq key 'translation-table-for-decode) - (setq key :decode-translation-table)) - ((eq key 'translation-table-for-encode) - (setq key :encode-translation-table)) - ((eq key 'safe-charsets) - (setq key :charset-list)) - ((eq key 'mime-charset) - (setq key :mime-charset)) - ((eq key 'valid-codes) - (setq key :valids))) - (setq plist (plist-put plist key (cdr elt)))) - plist)) - (setq properties (plist-put properties :mnemonic mnemonic)) - (plist-put properties :coding-type type) - (cond ((eq eol-type 0) (setq eol-type 'unix)) - ((eq eol-type 1) (setq eol-type 'dos)) - ((eq eol-type 2) (setq eol-type 'mac)) - ((vectorp eol-type) (setq eol-type nil))) - (plist-put properties :eol-type eol-type) - - (cond - ((eq type 'iso2022) - (plist-put properties :flags - (list (and (or (consp (nth 0 flags)) - (consp (nth 1 flags)) - (consp (nth 2 flags)) - (consp (nth 3 flags))) 'designation) - (or (nth 4 flags) 'long-form) - (and (nth 5 flags) 'ascii-at-eol) - (and (nth 6 flags) 'ascii-at-cntl) - (and (nth 7 flags) '7-bit) - (and (nth 8 flags) 'locking-shift) - (and (nth 9 flags) 'single-shift) - (and (nth 10 flags) 'use-roman) - (and (nth 11 flags) 'use-oldjis) - (or (nth 12 flags) 'direction) - (and (nth 13 flags) 'init-at-bol) - (and (nth 14 flags) 'designate-at-bol) - (and (nth 15 flags) 'safe) - (and (nth 16 flags) 'latin-extra))) - (plist-put properties :designation - (let ((vec (make-vector 4 nil))) - (dotimes (i 4) - (let ((spec (nth i flags))) - (if (eq spec t) - (aset vec i '(94 96)) - (if (consp spec) - (progn - (if (memq t spec) - (setq spec (append (delq t spec) '(94 96)))) - (aset vec i spec)))))) - vec))) - - ((eq type 'ccl) - (plist-put properties :ccl-decoder (car flags)) - (plist-put properties :ccl-encoder (cdr flags)))) - - (apply 'define-coding-system coding-system doc-string properties)) - (defun merge-coding-systems (first second) "Fill in any unspecified aspects of coding system FIRST from SECOND. Return the resulting coding system." @@ -1616,15 +1492,6 @@ This setting is effective for the next communication only." (setq next-selection-coding-system coding-system)) -(defun set-coding-priority (arg) - "Set priority of coding categories according to ARG. -ARG is a list of coding categories ordered by priority. - -This function is provided for backward compatibility." - (declare (obsolete set-coding-system-priority "23.1")) - (apply 'set-coding-system-priority - (mapcar #'(lambda (x) (symbol-value x)) arg))) - ;;; X selections (defvar ctext-non-standard-encodings-alist diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el index 7f2a99a41a2..1888c8f86a2 100644 --- a/lisp/language/burmese.el +++ b/lisp/language/burmese.el @@ -23,7 +23,6 @@ ;;; Commentary: -;; Aung San Suu Kyi says to call her country "Burma". ;; The murderous generals say to call it "Myanmar". ;; We will call it "Burma". -- rms, Chief GNUisance. diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el index a3a6f3fdd94..ce60d1a3ad4 100644 --- a/lisp/language/cyril-util.el +++ b/lisp/language/cyril-util.el @@ -47,7 +47,7 @@ ;;;###autoload (defun standard-display-cyrillic-translit (&optional cyrillic-language) - "Display a cyrillic buffer using a transliteration. + "Display a Cyrillic buffer using a transliteration. For readability, the table is slightly different from the one used for the input method `cyrillic-translit'. diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el index 19cba91556b..f38dead5a23 100644 --- a/lisp/language/hanja-util.el +++ b/lisp/language/hanja-util.el @@ -22,7 +22,7 @@ ;;; Commentary: -;; This file defines korean hanja table and symbol table. +;; This file defines the Korean Hanja table and symbol table. ;;; Code: @@ -31,7 +31,7 @@ (defvar hanja-table nil "A char table for Hanja characters. -It maps a hangul character to a list of the corresponding Hanja characters. +It maps a Hangul character to a list of the corresponding Hanja characters. Each element of the list has the form CHAR or (CHAR . STRING) where CHAR is a Hanja character and STRING is the meaning of that character. This variable is initialized by `hanja-init-load'.") diff --git a/lisp/language/indian.el b/lisp/language/indian.el index eb882c810e1..657ad6915eb 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -25,7 +25,7 @@ ;;; Commentary: ;; This file contains definitions of Indian language environments, and -;; setups for displaying the scrtipts used there. +;; setups for displaying the scripts used there. ;;; Code: diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index ae58bfc566b..7077925602c 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -31062,7 +31062,7 @@ values), despite potential performance issues, type \\[so-long-revert]. Use \\[so-long-commentary] for more information. -Use \\[so-long-customize] to configure the behavior. +Use \\[so-long-customize] to configure the behaviour. \(fn)" t nil) @@ -31099,7 +31099,7 @@ or call the function `global-so-long-mode'.") (custom-autoload 'global-so-long-mode "so-long" nil) (autoload 'global-so-long-mode "so-long" "\ -Toggle automated performance mitigation for files with long lines. +Toggle automated performance mitigations for files with long lines. If called interactively, enable Global So-Long mode if ARG is positive, and disable it if ARG is zero or negative. If called from @@ -31118,7 +31118,7 @@ When such files are detected by `so-long-predicate', we invoke the selected Use \\[so-long-commentary] for more information. -Use \\[so-long-customize] to configure the behavior. +Use \\[so-long-customize] to configure the behaviour. \(fn &optional ARG)" t nil) diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index 78ffca9e2fa..6a2508ba31d 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -242,12 +242,14 @@ system, including many technical ones. Examples: ((lambda (name char) ;; "GREEK SMALL LETTER PHI" (which is \phi) and "GREEK PHI SYMBOL" ;; (which is \varphi) are reversed in `ucs-names', so we define - ;; them manually. - (unless (string-match-p "\\<PHI\\>" name) + ;; them manually. Also ignore "GREEK SMALL LETTER EPSILON" and + ;; add the correct value for \epsilon manually. + (unless (string-match-p "\\<\\(?:PHI\\|GREEK SMALL LETTER EPSILON\\)\\>" name) (concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase) (match-string 2 name))))) "\\`GREEK \\(?:SMALL\\|CAPITA\\(L\\)\\) LETTER \\([^- ]+\\)\\'") + ("\\epsilon" ?ϵ) ("\\phi" ?ϕ) ("\\Box" ?□) ("\\Bumpeq" ?≎) @@ -641,6 +643,7 @@ system, including many technical ones. Examples: (concat "\\var" (downcase (match-string 1 name))))) "\\`GREEK \\([^- ]+\\) SYMBOL\\'") + ("\\varepsilon" ?ε) ("\\varphi" ?φ) ("\\varprime" ?′) ("\\varpropto" ?∝) diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index 896f82d7bcc..2c77f88f97b 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -83,10 +83,8 @@ input and write the converted data to its standard output." "^[^:]...............................................................$") (defconst binhex-end-line ":$") ; unused -(defvar binhex-temporary-file-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/"))) +(make-obsolete-variable 'binhex-temporary-file-directory + 'temporary-file-directory "28.1") (defun binhex-insert-char (char &optional count ignored buffer) "Insert COUNT copies of CHARACTER into BUFFER." @@ -285,7 +283,7 @@ If HEADER-ONLY is non-nil only decode header and return filename." (file-name (expand-file-name (concat (binhex-decode-region-internal start end t) ".data") - binhex-temporary-file-directory))) + temporary-file-directory))) (save-excursion (goto-char start) (when (re-search-forward binhex-begin-line nil t) @@ -296,7 +294,7 @@ If HEADER-ONLY is non-nil only decode header and return filename." (generate-new-buffer " *binhex-work*"))) (buffer-disable-undo work-buffer) (insert-buffer-substring cbuf firstline end) - (cd binhex-temporary-file-directory) + (cd temporary-file-directory) (apply 'call-process-region (point-min) (point-max) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index efbc0668553..6b9e1db5fc6 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -324,18 +324,6 @@ usually do not have translators for other languages.\n\n"))) (let ((os (ignore-errors (report-emacs-bug--os-description)))) (if (stringp os) (insert "System Description: " os "\n\n"))) - (let ((message-buf (get-buffer "*Messages*"))) - (if message-buf - (let (beg-pos - (end-pos message-end-point)) - (with-current-buffer message-buf - (goto-char end-pos) - (forward-line -10) - (setq beg-pos (point))) - (terpri (current-buffer) t) - (insert "Recent messages:\n") - (insert-buffer-substring message-buf beg-pos end-pos)))) - (insert "\n") (when (and system-configuration-options (not (equal system-configuration-options ""))) (insert "Configured using:\n 'configure " diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el index af3b493a08a..f4b55031194 100644 --- a/lisp/mail/flow-fill.el +++ b/lisp/mail/flow-fill.el @@ -131,31 +131,37 @@ lines." (goto-char (match-end 0)) (unless (looking-at " ") (insert " ")) - (end-of-line) - (when (and (not (eobp)) - (save-excursion - (forward-line 1) - (looking-at (format "\\(%s ?\\)[^>]" prefix)))) - ;; Delete the newline and the quote at the start of the - ;; next line. - (delete-region (point) (match-end 1)) - (ignore-errors + (while (and (eq (char-before (line-end-position)) ?\s) + (not (eobp)) + (save-excursion + (forward-line 1) + (looking-at (format "\\(%s ?\\)[^>]" prefix)))) + (end-of-line) + (when (and (not (eobp)) + (save-excursion + (forward-line 1) + (looking-at (format "\\(%s ?\\)[^>]" prefix)))) + ;; Delete the newline and the quote at the start of the + ;; next line. + (delete-region (point) (match-end 1)))) + (ignore-errors (let ((fill-prefix (concat prefix " ")) adaptive-fill-mode) (fill-region (line-beginning-position) (line-end-position) - 'left 'nosqueeze)))))) - (t + 'left 'nosqueeze))))) + (t ;; Delete the newline. (when (eq (following-char) ?\s) (delete-char 1)) ;; Hack: Don't do the flowing on the signature line. (when (and (not (looking-at "-- $")) (eq (char-before (line-end-position)) ?\s)) - (end-of-line) - (when delete-space - (delete-char -1)) - (delete-char 1) + (while (eq (char-before (line-end-position)) ?\s) + (end-of-line) + (when delete-space + (delete-char -1)) + (delete-char 1)) (ignore-errors (let ((fill-prefix "")) (fill-region (line-beginning-position) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 44cde7cb5a9..312baffb901 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -521,25 +521,6 @@ still the current message in the Rmail buffer.") (defvar rmail-mmdf-delim2 "^\001\001\001\001\n" "Regexp marking the end of an mmdf message.") -;; FIXME Post-mbox, this is now unused. -;; In Emacs-22, this was called: -;; i) the very first time a message was shown. -;; ii) when toggling the headers to the normal state, every time. -;; It's not clear what it should do now, since there is nothing that -;; records when a message is shown for the first time (unseen is not -;; necessarily the same thing). -;; See https://lists.gnu.org/r/emacs-devel/2009-03/msg00013.html -(defcustom rmail-message-filter nil - "If non-nil, a filter function for new messages in RMAIL. -Called with region narrowed to the message, including headers, -before obeying `rmail-ignored-headers'." - :group 'rmail-headers - :type '(choice (const nil) function)) - -(make-obsolete-variable 'rmail-message-filter - "it is not used (try `rmail-show-message-hook')." - "23.1") - (defcustom rmail-automatic-folder-directives nil "List of directives specifying how to automatically file messages. Whenever Rmail shows a message in the folder that `rmail-file-name' diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index ba6ebad082c..3026283a082 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -63,9 +63,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'. (use-local-map rmail-edit-map) (setq major-mode 'rmail-edit-mode) (setq mode-name "RMAIL Edit") - (if (boundp 'mode-line-modified) - (setq mode-line-modified (default-value 'mode-line-modified)) - (setq mode-line-format (default-value 'mode-line-format))) + (setq mode-line-modified (default-value 'mode-line-modified)) ;; Don't turn off auto-saving based on the size of the buffer ;; because that code does not understand buffer-swapping. (make-local-variable 'auto-save-include-big-deletions) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index f5c9432879f..666395e0b9e 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -53,6 +53,7 @@ ;; See http://www.ietf.org/rfc/rfc2554.txt ;;; Code: +;;; Dependencies (require 'sendmail) (require 'auth-source) @@ -61,12 +62,12 @@ (autoload 'message-make-message-id "message") (autoload 'rfc2104-hash "rfc2104") -;;; +;;; Options + (defgroup smtpmail nil "SMTP protocol for sending mail." :group 'mail) - (defcustom smtpmail-default-smtp-server nil "Specify default SMTP server. This only has effect if you specify it before loading the smtpmail library." @@ -172,8 +173,7 @@ mean \"try again\"." :type 'integer :version "27.1") -;; End of customizable variables. - +;;; Variables (defvar smtpmail-address-buffer) (defvar smtpmail-recipient-address-list) @@ -192,6 +192,8 @@ for `smtpmail-try-auth-method'.") (defvar smtpmail-mail-address nil "Value to use for envelope-from address for mail from ambient buffer.") +;;; Functions + ;;;###autoload (defun smtpmail-send-it () (let ((errbuf (if mail-interactive diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el index 9423275b2e5..945bff35f79 100644 --- a/lisp/mail/uudecode.el +++ b/lisp/mail/uudecode.el @@ -61,10 +61,8 @@ input and write the converted data to its standard output." (setq str (concat str "[^a-z]"))) (concat str ".?$"))) -(defvar uudecode-temporary-file-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp"))) +(make-obsolete-variable 'uudecode-temporary-file-directory + 'temporary-file-directory "28.1") ;;;###autoload (defun uudecode-decode-region-external (start end &optional file-name) @@ -86,13 +84,7 @@ used is specified by `uudecode-decoder-program'." (match-string 1))))) (setq tempfile (if file-name (expand-file-name file-name) - (if (fboundp 'make-temp-file) - (let ((temporary-file-directory - uudecode-temporary-file-directory)) - (make-temp-file "uu")) - (expand-file-name - (make-temp-name "uu") - uudecode-temporary-file-directory)))) + (make-temp-file "uu"))) (let ((cdir default-directory) (default-process-coding-system nil)) (unwind-protect diff --git a/lisp/man.el b/lisp/man.el index e1dd5037c46..da8a15f69b9 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -836,9 +836,10 @@ POS defaults to `point'." ;; ====================================================================== ;; Top level command and background process sentinel -;; For compatibility with older versions. +;; This alias was originally for compatibility with older versions. +;; Some users got used to having it, so we will not remove it. ;;;###autoload -(define-obsolete-function-alias 'manual-entry 'man "28.1") +(defalias 'manual-entry 'man) (defvar Man-completion-cache nil ;; On my machine, "man -k" is so fast that a cache makes no sense, diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index d2c3f9045e5..641a2e53152 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -685,13 +685,6 @@ for use at QPOS." completions) qboundary)))) -;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b)) -;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun)) -(define-obsolete-function-alias - 'complete-in-turn #'completion-table-in-turn "23.1") -(define-obsolete-function-alias - 'dynamic-completion-table #'completion-table-dynamic "23.1") - ;;; Minibuffer completion (defgroup minibuffer nil @@ -1126,6 +1119,7 @@ completion candidates than this number." (defvar-local completion-all-sorted-completions nil) (defvar-local completion--all-sorted-completions-location nil) (defvar completion-cycling nil) ;Function that takes down the cycling map. +(defvar completion-content-when-empty nil) (defvar completion-fail-discreetly nil "If non-nil, stay quiet when there is no match.") @@ -1510,8 +1504,13 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', COMPLETION-FUNCTION is called if the current buffer's content does not appear to be a match." (cond - ;; Allow user to specify null string - ((= beg end) (funcall exit-function)) + ;; Allow user to specify null string. In the case that + ;; `completion-content-when-empty' is set, use that instead. + ((= beg end) + (when completion-content-when-empty + (completion--replace beg end completion-content-when-empty)) + (funcall exit-function)) + ((test-completion (buffer-substring beg end) minibuffer-completion-table minibuffer-completion-predicate) @@ -1770,9 +1769,6 @@ It also eliminates runs of equal strings." ;; Round up to a whole number of columns. (* colwidth (ceiling length colwidth)))))))))))) -(defvar completion-common-substring nil) -(make-obsolete-variable 'completion-common-substring nil "23.1") - (defvar completion-setup-hook nil "Normal hook run at the end of setting up a completion list buffer. When this hook is run, the current buffer is the one in which the @@ -1864,11 +1860,7 @@ It can find the completion buffer in `standard-output'." (insert "Possible completions are:\n") (completion--insert-strings completions)))) - ;; The hilit used to be applied via completion-setup-hook, so there - ;; may still be some code that uses completion-common-substring. - (with-no-warnings - (let ((completion-common-substring common-substring)) - (run-hooks 'completion-setup-hook))) + (run-hooks 'completion-setup-hook) nil) (defvar completion-extra-properties nil @@ -2374,8 +2366,6 @@ The completion method is determined by `completion-at-point-functions'." Gets combined either with `minibuffer-local-completion-map' or with `minibuffer-local-must-match-map'.") -(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map - 'minibuffer-local-filename-must-match-map "23.1") (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) (make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1") diff --git a/lisp/mouse.el b/lisp/mouse.el index d369545f18e..a06ca2a56ca 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -274,34 +274,6 @@ not it is actually displayed." local-menu minor-mode-menus))) -(defun mouse-major-mode-menu (event &optional prefix) - "Pop up a mode-specific menu of mouse commands. -Default to the Edit menu if the major mode doesn't define a menu." - (declare (obsolete mouse-menu-major-mode-map "23.1")) - (interactive "@e\nP") - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (popup-menu (mouse-menu-major-mode-map) event prefix)) - -(defun mouse-popup-menubar (event prefix) - "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX. -The contents are the items that would be in the menu bar whether or -not it is actually displayed." - (declare (obsolete mouse-menu-bar-map "23.1")) - (interactive "@e \nP") - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix)) - -(defun mouse-popup-menubar-stuff (event prefix) - "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'. -Use the former if the menu bar is showing, otherwise the latter." - (declare (obsolete nil "23.1")) - (interactive "@e\nP") - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (popup-menu - (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0)) - (mouse-menu-bar-map) - (mouse-menu-major-mode-map)) - event prefix)) ;; Commands that operate on windows. diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 317f2cd8edd..8e2039ba9d8 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -162,23 +162,18 @@ Also see `mouse-wheel-tilt-scroll'." :type 'boolean :version "26.1") -(eval-and-compile - (if (fboundp 'event-button) - (fset 'mwheel-event-button 'event-button) - (defun mwheel-event-button (event) - (let ((x (event-basic-type event))) - ;; Map mouse-wheel events to appropriate buttons - (if (eq 'mouse-wheel x) - (let ((amount (car (cdr (cdr (cdr event)))))) - (if (< amount 0) - mouse-wheel-up-event - mouse-wheel-down-event)) - x)))) - - (if (fboundp 'event-window) - (fset 'mwheel-event-window 'event-window) - (defun mwheel-event-window (event) - (posn-window (event-start event))))) +(defun mwheel-event-button (event) + (let ((x (event-basic-type event))) + ;; Map mouse-wheel events to appropriate buttons + (if (eq 'mouse-wheel x) + (let ((amount (car (cdr (cdr (cdr event)))))) + (if (< amount 0) + mouse-wheel-up-event + mouse-wheel-down-event)) + x))) + +(defun mwheel-event-window (event) + (posn-window (event-start event))) (defvar mwheel-inhibit-click-event-timer nil "Timer running while mouse wheel click event is inhibited.") diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 8892e800cd6..2b8d4d0ce62 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1,4 +1,4 @@ -;;; browse-url.el --- pass a URL to a WWW browser +;;; browse-url.el --- pass a URL to a WWW browser -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2020 Free Software Foundation, Inc. @@ -425,25 +425,6 @@ Passing an interactive argument to \\[browse-url], or specific browser commands reverses the effect of this variable." :type 'boolean) -(defcustom browse-url-mosaic-program "xmosaic" - "The name by which to invoke Mosaic (or mMosaic)." - :type 'string - :version "20.3") - -(make-obsolete-variable 'browse-url-mosaic-program nil "25.1") - -(defcustom browse-url-mosaic-arguments nil - "A list of strings to pass to Mosaic as arguments." - :type '(repeat (string :tag "Argument"))) - -(make-obsolete-variable 'browse-url-mosaic-arguments nil "25.1") - -(defcustom browse-url-mosaic-pidfile "~/.mosaicpid" - "The name of the pidfile created by Mosaic." - :type 'string) - -(make-obsolete-variable 'browse-url-mosaic-pidfile nil "25.1") - (defcustom browse-url-conkeror-program "conkeror" "The name by which to invoke Conkeror." :type 'string @@ -498,22 +479,6 @@ Used by the `browse-url-of-file' command." "Hook run after `browse-url-of-file' has asked a browser to load a file." :type 'hook) -(defcustom browse-url-CCI-port 3003 - "Port to access XMosaic via CCI. -This can be any number between 1024 and 65535 but must correspond to -the value set in the browser." - :type 'integer) - -(make-obsolete-variable 'browse-url-CCI-port nil "25.1") - -(defcustom browse-url-CCI-host "localhost" - "Host to access XMosaic via CCI. -This should be the host name of the machine running XMosaic with CCI -enabled. The port number should be set in `browse-url-CCI-port'." - :type 'string) - -(make-obsolete-variable 'browse-url-CCI-host nil "25.1") - (defvar browse-url-temp-file-name nil) (make-variable-buffer-local 'browse-url-temp-file-name) @@ -622,7 +587,7 @@ process), or nil (we don't know)." kind))) (defun browse-url--mailto (url &rest args) - "Calls `browse-url-mailto-function' with URL and ARGS." + "Call `browse-url-mailto-function' with URL and ARGS." (funcall browse-url-mailto-function url args)) (defun browse-url--browser-kind-mailto (url) @@ -631,7 +596,7 @@ process), or nil (we don't know)." #'browse-url--browser-kind-mailto) (defun browse-url--man (url &rest args) - "Calls `browse-url-man-function' with URL and ARGS." + "Call `browse-url-man-function' with URL and ARGS." (funcall browse-url-man-function url args)) (defun browse-url--browser-kind-man (url) @@ -640,7 +605,7 @@ process), or nil (we don't know)." #'browse-url--browser-kind-man) (defun browse-url--browser (url &rest args) - "Calls `browse-url-browser-function' with URL and ARGS." + "Call `browse-url-browser-function' with URL and ARGS." (funcall browse-url-browser-function url args)) (defun browse-url--browser-kind-browser (url) @@ -854,8 +819,8 @@ narrowed." (browse-url-of-file file-name)))) (defun browse-url-delete-temp-file (&optional temp-file-name) - ;; Delete browse-url-temp-file-name from the file system - ;; If optional arg TEMP-FILE-NAME is non-nil, delete it instead + "Delete `browse-url-temp-file-name' from the file system. +If optional arg TEMP-FILE-NAME is non-nil, delete it instead." (let ((file-name (or temp-file-name browse-url-temp-file-name))) (if (and file-name (file-exists-p file-name)) (delete-file file-name)))) @@ -1075,8 +1040,6 @@ instead of `browse-url-new-window-flag'." ;;; ((executable-find browse-url-galeon-program) 'browse-url-galeon) ((executable-find browse-url-kde-program) 'browse-url-kde) ;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape) -;;; ((executable-find browse-url-mosaic-program) 'browse-url-mosaic) -;;; ((executable-find browse-url-conkeror-program) 'browse-url-conkeror) ((executable-find browse-url-chrome-program) 'browse-url-chrome) ((executable-find browse-url-xterm-program) 'browse-url-text-xterm) ((locate-library "w3") 'browse-url-w3) @@ -1444,93 +1407,6 @@ used instead of `browse-url-new-window-flag'." (function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external) -;; --- Mosaic --- - -;;;###autoload -(defun browse-url-mosaic (url &optional new-window) - "Ask the XMosaic WWW browser to load URL. - -Default to the URL around or before point. The strings in variable -`browse-url-mosaic-arguments' are also passed to Mosaic and the -program is invoked according to the variable -`browse-url-mosaic-program'. - -When called interactively, if variable `browse-url-new-window-flag' is -non-nil, load the document in a new Mosaic window, otherwise use a -random existing one. A non-nil interactive prefix argument reverses -the effect of `browse-url-new-window-flag'. - -When called non-interactively, optional second argument NEW-WINDOW is -used instead of `browse-url-new-window-flag'." - (declare (obsolete nil "25.1")) - (interactive (browse-url-interactive-arg "Mosaic URL: ")) - (let ((pidfile (expand-file-name browse-url-mosaic-pidfile)) - pid) - (if (file-readable-p pidfile) - (with-temp-buffer - (insert-file-contents pidfile) - (setq pid (read (current-buffer))))) - (if (and (integerp pid) (zerop (signal-process pid 0))) ; Mosaic running - (progn - (with-temp-buffer - (insert (if (browse-url-maybe-new-window new-window) - "newwin\n" - "goto\n") - url "\n") - (with-file-modes ?\700 - (if (file-exists-p - (setq pidfile (format "/tmp/Mosaic.%d" pid))) - (delete-file pidfile)) - ;; https://debbugs.gnu.org/17428. Use O_EXCL. - (write-region nil nil pidfile nil 'silent nil 'excl))) - ;; Send signal SIGUSR to Mosaic - (message "Signaling Mosaic...") - (signal-process pid 'SIGUSR1) - ;; Or you could try: - ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) - (message "Signaling Mosaic...done")) - ;; Mosaic not running - start it - (message "Starting %s..." browse-url-mosaic-program) - (apply 'start-process "xmosaic" nil browse-url-mosaic-program - (append browse-url-mosaic-arguments (list url))) - (message "Starting %s...done" browse-url-mosaic-program)))) - -(function-put 'browse-url-mosaic 'browse-url-browser-kind 'external) - -;; --- Mosaic using CCI --- - -;;;###autoload -(defun browse-url-cci (url &optional new-window) - "Ask the XMosaic WWW browser to load URL. -Default to the URL around or before point. - -This function only works for XMosaic version 2.5 or later. You must -select `CCI' from XMosaic's File menu, set the CCI Port Address to the -value of variable `browse-url-CCI-port', and enable `Accept requests'. - -When called interactively, if variable `browse-url-new-window-flag' is -non-nil, load the document in a new browser window, otherwise use a -random existing one. A non-nil interactive prefix argument reverses -the effect of `browse-url-new-window-flag'. - -When called non-interactively, optional second argument NEW-WINDOW is -used instead of `browse-url-new-window-flag'." - (declare (obsolete nil "25.1")) - (interactive (browse-url-interactive-arg "Mosaic URL: ")) - (open-network-stream "browse-url" " *browse-url*" - browse-url-CCI-host browse-url-CCI-port) - ;; Todo: start browser if fails - (process-send-string "browse-url" - (concat "get url (" url ") output " - (if (browse-url-maybe-new-window new-window) - "new" - "current") - "\r\n")) - (process-send-string "browse-url" "disconnect\r\n") - (delete-process "browse-url")) - -(function-put 'browse-url-cci 'browse-url-browser-kind 'external) - ;; --- Conkeror --- ;;;###autoload (defun browse-url-conkeror (url &optional new-window) diff --git a/lisp/net/dns.el b/lisp/net/dns.el index c3c294395cb..c368cd773c2 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -316,8 +316,6 @@ If TCP-P, the first two bytes of the packet will be the length field." "Return false if we need to recheck the list of DNS servers." (and dns-servers (or (eq dns-servers-valid-for-interfaces t) - ;; `network-interface-list' was introduced in Emacs 22.1. - (not (fboundp 'network-interface-list)) (equal dns-servers-valid-for-interfaces (network-interface-list))))) @@ -339,8 +337,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." (when (re-search-forward "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\|[[:xdigit:]:]*\\)" nil t) (setq dns-servers (list (match-string 1))))))) - (when (fboundp 'network-interface-list) - (setq dns-servers-valid-for-interfaces (network-interface-list)))) + (setq dns-servers-valid-for-interfaces (network-interface-list))) (defun dns-read-txt (string) (if (> (length string) 1) diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 20a5c5f6075..bb6682520ae 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -1,4 +1,4 @@ -;;; eudc-bob.el --- Binary Objects Support for EUDC +;;; eudc-bob.el --- Binary Objects Support for EUDC -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -39,19 +39,41 @@ (require 'eudc) -(defvar eudc-bob-generic-keymap nil +(defvar eudc-bob-generic-keymap + (let ((map (make-sparse-keymap))) + (define-key map "s" 'eudc-bob-save-object) + (define-key map "!" 'eudc-bob-pipe-object-to-external-program) + (define-key map [down-mouse-3] 'eudc-bob-popup-menu) + map) "Keymap for multimedia objects.") -(defvar eudc-bob-image-keymap nil +(defvar eudc-bob-image-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map eudc-bob-generic-keymap) + (define-key map "t" 'eudc-bob-toggle-inline-display) + map) "Keymap for inline images.") -(defvar eudc-bob-sound-keymap nil +(defvar eudc-bob-sound-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map eudc-bob-generic-keymap) + (define-key map (kbd "RET") 'eudc-bob-play-sound-at-point) + (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse) + map) "Keymap for inline sounds.") -(defvar eudc-bob-url-keymap nil +(defvar eudc-bob-url-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'browse-url-at-point) + (define-key map [down-mouse-2] 'browse-url-at-mouse) + map) "Keymap for inline urls.") -(defvar eudc-bob-mail-keymap nil +(defvar eudc-bob-mail-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'goto-address-at-point) + (define-key map [down-mouse-2] 'goto-address-at-point) + map) "Keymap for inline e-mail addresses.") (defvar eudc-bob-generic-menu @@ -71,16 +93,9 @@ `("EUDC Sound Menu" ["---" nil nil] ["Play sound" eudc-bob-play-sound-at-point - (fboundp 'play-sound)] + (fboundp 'play-sound-internal)] ,@(cdr (cdr eudc-bob-generic-menu)))) -(defun eudc-jump-to-event (event) - "Jump to the window and point where EVENT occurred." - (if (fboundp 'event-closest-point) - (goto-char (event-closest-point event)) - (set-buffer (window-buffer (posn-window (event-start event)))) - (goto-char (posn-point (event-start event))))) - (defun eudc-bob-get-overlay-prop (prop) "Get property PROP from one of the overlays around." (let ((overlays (append (overlays-at (1- (point))) @@ -197,7 +212,7 @@ display a button." (let (sound) (if (null (setq sound (eudc-bob-get-overlay-prop 'object-data))) (error "No sound data available here") - (unless (fboundp 'play-sound) + (unless (fboundp 'play-sound-internal) (error "Playing sounds not supported on this system")) (play-sound (list 'sound :data sound))))) @@ -205,44 +220,30 @@ display a button." "Play the sound data contained in the button where EVENT occurred." (interactive "e") (save-excursion - (eudc-jump-to-event event) + (mouse-set-point event) (eudc-bob-play-sound-at-point))) -(defun eudc-bob-save-object () +(defun eudc-bob-save-object (filename) "Save the object data of the button at point." - (interactive) + (interactive "fWrite file: ") (let ((data (eudc-bob-get-overlay-prop 'object-data)) - (buffer (generate-new-buffer "*eudc-tmp*"))) - (save-excursion - (if (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system 'binary)) - (set-buffer buffer) - (set-buffer-multibyte nil) - (insert data) - (save-buffer)) - (kill-buffer buffer))) + (coding-system-for-write 'binary)) ;Inhibit EOL conversion. + (write-region data nil filename))) -(defun eudc-bob-pipe-object-to-external-program () +(defun eudc-bob-pipe-object-to-external-program (program) "Pipe the object data of the button at point to an external program." - (interactive) + (interactive (list (completing-read "Viewer: " eudc-external-viewers))) (let ((data (eudc-bob-get-overlay-prop 'object-data)) - (buffer (generate-new-buffer "*eudc-tmp*")) - program - viewer) - (condition-case nil - (save-excursion - (if (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system 'binary)) - (set-buffer buffer) - (insert data) - (setq program (completing-read "Viewer: " eudc-external-viewers)) - (if (setq viewer (assoc program eudc-external-viewers)) - (call-process-region (point-min) (point-max) - (car (cdr viewer)) - (cdr (cdr viewer))) - (call-process-region (point-min) (point-max) program))) - (error - (kill-buffer buffer))))) + (viewer (assoc program eudc-external-viewers))) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert data) + (let ((coding-system-for-write 'binary)) ;Inhibit EOL conversion + (if viewer + (call-process-region (point-min) (point-max) + (car (cdr viewer)) + (cdr (cdr viewer))) + (call-process-region (point-min) (point-max) program)))))) (defun eudc-bob-menu () "Retrieve the menu attached to a binary object." @@ -252,47 +253,8 @@ display a button." "Pop-up a menu of EUDC multimedia commands." (interactive "@e") (run-hooks 'activate-menubar-hook) - (eudc-jump-to-event event) - (let ((result (x-popup-menu t (eudc-bob-menu))) - command) - (if result - (progn - (setq command (lookup-key (eudc-bob-menu) - (apply 'vector result))) - (command-execute command))))) - -(setq eudc-bob-generic-keymap - (let ((map (make-sparse-keymap))) - (define-key map "s" 'eudc-bob-save-object) - (define-key map "!" 'eudc-bob-pipe-object-to-external-program) - (define-key map [down-mouse-3] 'eudc-bob-popup-menu) - map)) - -(setq eudc-bob-image-keymap - (let ((map (make-sparse-keymap))) - (define-key map "t" 'eudc-bob-toggle-inline-display) - map)) - -(setq eudc-bob-sound-keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'eudc-bob-play-sound-at-point) - (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse) - map)) - -(setq eudc-bob-url-keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'browse-url-at-point) - (define-key map [down-mouse-2] 'browse-url-at-mouse) - map)) - -(setq eudc-bob-mail-keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'goto-address-at-point) - (define-key map [down-mouse-2] 'goto-address-at-point) - map)) - -(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap) -(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap) + (mouse-set-point event) + (popup-menu (eudc-bob-menu) event)) ;; If the first arguments can be nil here, then these 3 can be ;; defconsts once more. diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el index f258d5cb9fb..e2d10e33d49 100644 --- a/lisp/net/eudcb-macos-contacts.el +++ b/lisp/net/eudcb-macos-contacts.el @@ -1,19 +1,23 @@ ;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend -;; Copyright (C) 2020 condition-alpha.com +;; Copyright (C) 2020 Free Software Foundation, Inc. -;; This program is free software: you can redistribute it and/or modify +;; Author: Alexander Adolf + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, + +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; This library provides an interface to the macOS Contacts app as diff --git a/lisp/net/eww.el b/lisp/net/eww.el index edb2f729c8b..04deb5bee05 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -277,6 +277,24 @@ This list can be customized via `eww-suggest-uris'." (nreverse uris))) ;;;###autoload +(defun eww-browse () + "Function to be run to parse command line URLs. +This is meant to be used for MIME handlers or command line use. + +Setting the handler for \"text/x-uri;\" to +\"emacs -f eww-browse %u\" will then start up Emacs and call eww +to browse the url. + +This can also be used on the command line directly: + + emacs -f eww-browse https://gnu.org + +will start Emacs and browse the GNU web site." + (interactive) + (eww (pop command-line-args-left))) + + +;;;###autoload (defun eww (url &optional arg buffer) "Fetch URL and render the page. If the input doesn't look like an URL or a domain name, the @@ -654,9 +672,30 @@ Currently this means either text/html or application/xhtml+xml." (setq header-line-format (and eww-header-line-format (let ((title (plist-get eww-data :title)) - (peer (plist-get eww-data :peer))) + (peer (plist-get eww-data :peer)) + (url (plist-get eww-data :url))) (when (zerop (length title)) (setq title "[untitled]")) + ;; Limit the length of the title so that the host name + ;; of the URL is always visible. + (when url + (let* ((parsed (url-generic-parse-url url)) + (host-length (length (format "%s://%s" + (url-type parsed) + (url-host parsed)))) + (width (window-width))) + (cond + ;; The host bit is wider than the window, so nix + ;; the title. + ((> (+ host-length 5) width) + (setq title "")) + ;; Trim the title. + ((> (+ (length title) host-length 2) width) + (setq title (concat + (substring title 0 (- width + host-length + 5)) + "...")))))) ;; This connection has is https. (when peer (setq title @@ -668,7 +707,7 @@ Currently this means either text/html or application/xhtml+xml." "%" "%%" (format-spec eww-header-line-format - `((?u . ,(or (plist-get eww-data :url) "")) + `((?u . ,(or url "")) (?t . ,title)))))))) (defun eww-tag-title (dom) 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/net/imap.el b/lisp/net/imap.el index a492dc8c798..22b59084004 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -134,6 +134,7 @@ ;; ;;; Code: +;;; Dependencies (eval-when-compile (require 'cl-lib)) (require 'utf7) @@ -145,7 +146,7 @@ (declare-function digest-md5-digest-uri "ext:digest-md5") (declare-function digest-md5-challenge "ext:digest-md5") -;; User variables. +;;; User variables (defgroup imap nil "Low-level IMAP issues." @@ -257,7 +258,7 @@ Shorter values mean quicker response, but is more CPU intensive." :group 'imap :type 'boolean) -;; Various variables. +;;; Various variables (defvar imap-fetch-data-hook nil "Hooks called after receiving each FETCH response.") @@ -316,7 +317,9 @@ the value of this variable will be bound to a certain value to which an application program that uses this module specifies on a per-server basis.") -;; Internal constants. Change these and die. +;;; Internal constants + +;; Change these and die. (defconst imap-default-port 143) (defconst imap-default-ssl-port 993) @@ -348,7 +351,7 @@ basis.") (defconst imap-log-buffer "*imap-log*") (defconst imap-debug-buffer "*imap-debug*") -;; Internal variables. +;;; Internal variables (defvar imap-stream nil) (defvar imap-auth nil) @@ -437,7 +440,7 @@ This variable is set to t automatically per server if the canonical form fails.") -;; Utility functions: +;;; Utility functions (defun imap-remassoc (key alist) "Delete by side effect any elements of ALIST whose car is `equal' to KEY. @@ -489,7 +492,8 @@ sure of changing the value of `foo'." (nth 3 (car imap-failed-tags)))) -;; Server functions; stream stuff: +;;; Server functions +;;;; Stream functions (defun imap-log (string-or-buffer) (when imap-log @@ -747,7 +751,7 @@ sure of changing the value of `foo'." (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed")) done)) -;; Server functions; authenticator stuff: +;;;; Authenticator functions (defun imap-interactive-login (buffer loginfunc) "Login to server in BUFFER. @@ -871,7 +875,7 @@ t if it successfully authenticates, nil otherwise." (concat "LOGIN anonymous \"" (concat (user-login-name) "@" (system-name)) "\""))))) -;;; Compiler directives. +;;; Compiler directives (defvar imap-sasl-client) (defvar imap-sasl-step) @@ -969,7 +973,7 @@ t if it successfully authenticates, nil otherwise." (imap-send-command-1 "") (imap-ok-p (imap-wait-for-tag tag))))))) -;; Server functions: +;;; Server functions (defun imap-open-1 (buffer) (with-current-buffer buffer @@ -1228,7 +1232,7 @@ If BUFFER is nil, the current buffer is assumed." (imap-send-command-wait "LOGOUT" buffer))) -;; Mailbox functions: +;;; Mailbox functions (defun imap-mailbox-put (propname value &optional mailbox buffer) (with-current-buffer (or buffer (current-buffer)) @@ -1520,7 +1524,7 @@ or `unseen'. The IMAP command tag is returned." identifier)))))) -;; Message functions: +;;; Message functions (defun imap-current-message (&optional buffer) (with-current-buffer (or buffer (current-buffer)) @@ -1832,7 +1836,7 @@ on failure." (if (aref from 0) ">")))) -;; Internal functions. +;;; Internal functions (defun imap-add-callback (tag func) (setq imap-callbacks (append (list (cons tag func)) imap-callbacks))) @@ -1969,7 +1973,7 @@ Return nil if no complete line has arrived." (delete-region (point-min) (point-max))))))))) -;; Imap parser. +;;; Imap parser (defsubst imap-forward () (or (eobp) (forward-char))) @@ -2850,6 +2854,8 @@ Return nil if no complete line has arrived." (imap-forward) (nreverse body))))) +;;; Debug + (when imap-debug ; (untrace-all) (require 'trace) (buffer-disable-undo (get-buffer-create imap-debug-buffer)) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 86f9d2bf07c..f01a5deb7ec 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -269,11 +269,6 @@ is consulted." (viewer . "display %s") (type . "image/*") (test . (eq window-system 'x)) - ("needsx11")) - (".*" - (viewer . "ee %s") - (type . "image/*") - (test . (eq window-system 'x)) ("needsx11"))) ("text" ("plain" diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index 1bed61f3e7d..ff8a447c7c1 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -131,14 +131,6 @@ groupcontent := feedname | groupdefinition) Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\") \"feed3\")") -(defcustom newsticker-groups-filename - nil - "Name of the newsticker groups settings file." - :version "25.1" ; changed default value to nil - :type '(choice (const nil) string) - :group 'newsticker-treeview) -(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1") - ;; ====================================================================== ;;; internal variables ;; ====================================================================== @@ -1265,29 +1257,9 @@ Note: does not update the layout." (defun newsticker--treeview-load () "Load treeview settings." (let* ((coding-system-for-read 'utf-8) - (filename - (or (and newsticker-groups-filename - (not (string= - (expand-file-name newsticker-groups-filename) - (expand-file-name (concat newsticker-dir "/groups")))) - (file-exists-p newsticker-groups-filename) - (y-or-n-p - (format-message - (concat "Obsolete variable `newsticker-groups-filename' " - "points to existing file \"%s\".\n" - "Read it? ") - newsticker-groups-filename)) - newsticker-groups-filename) - (concat newsticker-dir "/groups"))) + (filename (concat newsticker-dir "/groups")) (buf (and (file-exists-p filename) (find-file-noselect filename)))) - (and newsticker-groups-filename - (file-exists-p newsticker-groups-filename) - (y-or-n-p (format-message - (concat "Delete the file \"%s\",\nto which the obsolete " - "variable `newsticker-groups-filename' points ? ") - newsticker-groups-filename)) - (delete-file newsticker-groups-filename)) (when buf (set-buffer buf) (goto-char (point-min)) diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index ebcd21948bf..9401430799c 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -69,7 +69,6 @@ (require 'md4) (require 'hmac-md5) -(require 'calc) (defgroup ntlm nil "NTLM (NT LanManager) authentication." @@ -133,32 +132,27 @@ is not given." domain ;buffer field )))) -(defun ntlm-compute-timestamp () - "Compute an NTLMv2 timestamp. +(defun ntlm--time-to-timestamp (time) + "Convert TIME to an NTLMv2 timestamp. Return a unibyte string representing the number of tenths of a microsecond since January 1, 1601 as a 64-bit little-endian -signed integer." - ;; FIXME: This can likely be significantly simplified using the new - ;; bignums support! - (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)") - (us-to-tenths-of-us "mul($3,10)") - (ps-to-tenths-of-us "idiv($4,100000)") - (tenths-of-us-since-jan-1-1601 - (apply #'calc-eval (concat "add(add(add(" - s-to-tenths-of-us "," - us-to-tenths-of-us ")," - ps-to-tenths-of-us ")," - ;; tenths of microseconds between - ;; 1601-01-01 and 1970-01-01 - "116444736000000000)") - 'rawnum (time-convert nil 'list))) - result-bytes) - (dotimes (_byte 8) - (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601) - result-bytes) - (setq tenths-of-us-since-jan-1-1601 - (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601))) - (apply #'unibyte-string (nreverse result-bytes)))) +signed integer. TIME must be on the form (HIGH LOW USEC PSEC)." + (let* ((s (+ (ash (nth 0 time) 16) (nth 1 time))) + (us (nth 2 time)) + (ps (nth 3 time)) + (tenths-of-us-since-jan-1-1601 + (+ (* s 10000000) (* us 10) (/ ps 100000) + ;; tenths of microseconds between 1601-01-01 and 1970-01-01 + 116444736000000000))) + (apply #'unibyte-string + (mapcar (lambda (i) + (logand (ash tenths-of-us-since-jan-1-1601 (* i -8)) + #xff)) + (number-sequence 0 7))))) + +(defun ntlm-compute-timestamp () + "Current time as an NTLMv2 timestamp, as a unibyte string." + (ntlm--time-to-timestamp (time-convert nil 'list))) (defun ntlm-generate-nonce () "Generate a random nonce, not to be used more than once. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 88f5c2928e3..49ecaa58ee8 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -890,8 +890,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `make-process' for Tramp files. If connection property \"direct-async-process\" is non-nil, an alternative implementation will be used." - (if (tramp-get-connection-property - (tramp-dissect-file-name default-directory) "direct-async-process" nil) + (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3e2eb023a33..fae15fe6a8e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2790,8 +2790,7 @@ the result will be a local, non-Tramp, file name." STDERR can also be a file name. If connection property \"direct-async-process\" is non-nil, an alternative implementation will be used." - (if (tramp-get-connection-property - (tramp-dissect-file-name default-directory) "direct-async-process" nil) + (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil @@ -4782,104 +4781,6 @@ Goes through the list `tramp-inline-compress-commands'." (tramp-message vec 2 "Couldn't find an inline transfer compress command"))))) -;;;###tramp-autoload -(defun tramp-multi-hop-p (vec) - "Whether the method of VEC is capable of multi-hops." - (and (tramp-sh-file-name-handler-p vec) - (not (tramp-get-method-parameter vec 'tramp-copy-program)))) - -(defun tramp-compute-multi-hops (vec) - "Expands VEC according to `tramp-default-proxies-alist'." - (let ((saved-tdpa tramp-default-proxies-alist) - (target-alist `(,vec)) - (hops (or (tramp-file-name-hop vec) "")) - (item vec) - choices proxy) - - ;; Ad-hoc proxy definitions. - (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit))) - (let* ((host-port (tramp-file-name-host-port item)) - (user-domain (tramp-file-name-user-domain item)) - (proxy (concat - tramp-prefix-format proxy tramp-postfix-host-format)) - (entry - (list (and (stringp host-port) - (concat "^" (regexp-quote host-port) "$")) - (and (stringp user-domain) - (concat "^" (regexp-quote user-domain) "$")) - (propertize proxy 'tramp-ad-hoc t)))) - (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry) - ;; Add the hop. - (add-to-list 'tramp-default-proxies-alist entry) - (setq item (tramp-dissect-file-name proxy)))) - ;; Save the new value. - (when (and hops tramp-save-ad-hoc-proxies) - (customize-save-variable - 'tramp-default-proxies-alist tramp-default-proxies-alist)) - - ;; Look for proxy hosts to be passed. - (setq choices tramp-default-proxies-alist) - (while choices - (setq item (pop choices) - proxy (eval (nth 2 item))) - (when (and - ;; Host. - (string-match-p - (or (eval (nth 0 item)) "") - (or (tramp-file-name-host-port (car target-alist)) "")) - ;; User. - (string-match-p - (or (eval (nth 1 item)) "") - (or (tramp-file-name-user-domain (car target-alist)) ""))) - (if (null proxy) - ;; No more hops needed. - (setq choices nil) - ;; Replace placeholders. - (setq proxy - (format-spec - proxy - (format-spec-make - ?u (or (tramp-file-name-user (car target-alist)) "") - ?h (or (tramp-file-name-host (car target-alist)) "")))) - (with-parsed-tramp-file-name proxy l - ;; Add the hop. - (push l target-alist) - ;; Start next search. - (setq choices tramp-default-proxies-alist))))) - - ;; Foreign and out-of-band methods are not supported for multi-hops. - (when (cdr target-alist) - (setq choices target-alist) - (while (setq item (pop choices)) - (unless (tramp-multi-hop-p item) - (setq tramp-default-proxies-alist saved-tdpa) - (tramp-user-error - vec "Method `%s' is not supported for multi-hops." - (tramp-file-name-method item))))) - - ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the - ;; host name in their command template. In this case, the remote - ;; file name must use either a local host name (first hop), or a - ;; host name matching the previous hop. - (let ((previous-host (or tramp-local-host-regexp ""))) - (setq choices target-alist) - (while (setq item (pop choices)) - (let ((host (tramp-file-name-host item))) - (unless - (or - ;; The host name is used for the remote shell command. - (member - '("%h") (tramp-get-method-parameter item 'tramp-login-args)) - ;; The host name must match previous hop. - (string-match-p previous-host host)) - (setq tramp-default-proxies-alist saved-tdpa) - (tramp-user-error - vec "Host name `%s' does not match `%s'" host previous-host)) - (setq previous-host (concat "^" (regexp-quote host) "$"))))) - - ;; Result. - target-alist)) - (defun tramp-ssh-controlmaster-options (vec) "Return the Control* arguments of the local ssh." (cond diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d1b2935a3c6..83ade66ee14 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3633,18 +3633,126 @@ User is always nil." (load local-copy noerror t nosuffix must-suffix) (delete-file local-copy))))) t))) + +(defun tramp-multi-hop-p (vec) + "Whether the method of VEC is capable of multi-hops." + (and (tramp-sh-file-name-handler-p vec) + (not (tramp-get-method-parameter vec 'tramp-copy-program)))) + +(defun tramp-compute-multi-hops (vec) + "Expands VEC according to `tramp-default-proxies-alist'." + (let ((saved-tdpa tramp-default-proxies-alist) + (target-alist `(,vec)) + (hops (or (tramp-file-name-hop vec) "")) + (item vec) + choices proxy) + + ;; Ad-hoc proxy definitions. + (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit))) + (let* ((host-port (tramp-file-name-host-port item)) + (user-domain (tramp-file-name-user-domain item)) + (proxy (concat + tramp-prefix-format proxy tramp-postfix-host-format)) + (entry + (list (and (stringp host-port) + (concat "^" (regexp-quote host-port) "$")) + (and (stringp user-domain) + (concat "^" (regexp-quote user-domain) "$")) + (propertize proxy 'tramp-ad-hoc t)))) + (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry) + ;; Add the hop. + (add-to-list 'tramp-default-proxies-alist entry) + (setq item (tramp-dissect-file-name proxy)))) + ;; Save the new value. + (when (and hops tramp-save-ad-hoc-proxies) + (customize-save-variable + 'tramp-default-proxies-alist tramp-default-proxies-alist)) + + ;; Look for proxy hosts to be passed. + (setq choices tramp-default-proxies-alist) + (while choices + (setq item (pop choices) + proxy (eval (nth 2 item))) + (when (and + ;; Host. + (string-match-p + (or (eval (nth 0 item)) "") + (or (tramp-file-name-host-port (car target-alist)) "")) + ;; User. + (string-match-p + (or (eval (nth 1 item)) "") + (or (tramp-file-name-user-domain (car target-alist)) ""))) + (if (null proxy) + ;; No more hops needed. + (setq choices nil) + ;; Replace placeholders. + (setq proxy + (format-spec + proxy + (format-spec-make + ?u (or (tramp-file-name-user (car target-alist)) "") + ?h (or (tramp-file-name-host (car target-alist)) "")))) + (with-parsed-tramp-file-name proxy l + ;; Add the hop. + (push l target-alist) + ;; Start next search. + (setq choices tramp-default-proxies-alist))))) + + ;; Foreign and out-of-band methods are not supported for multi-hops. + (when (cdr target-alist) + (setq choices target-alist) + (while (setq item (pop choices)) + (unless (tramp-multi-hop-p item) + (setq tramp-default-proxies-alist saved-tdpa) + (tramp-user-error + vec "Method `%s' is not supported for multi-hops." + (tramp-file-name-method item))))) + + ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the + ;; host name in their command template. In this case, the remote + ;; file name must use either a local host name (first hop), or a + ;; host name matching the previous hop. + (let ((previous-host (or tramp-local-host-regexp ""))) + (setq choices target-alist) + (while (setq item (pop choices)) + (let ((host (tramp-file-name-host item))) + (unless + (or + ;; The host name is used for the remote shell command. + (member + '("%h") (tramp-get-method-parameter item 'tramp-login-args)) + ;; The host name must match previous hop. + (string-match-p previous-host host)) + (setq tramp-default-proxies-alist saved-tdpa) + (tramp-user-error + vec "Host name `%s' does not match `%s'" host previous-host)) + (setq previous-host (concat "^" (regexp-quote host) "$"))))) + + ;; Result. + target-alist)) + +(defun tramp-direct-async-process-p (&rest args) + "Whether direct async `make-process' can be called." + (let ((v (tramp-dissect-file-name default-directory))) + (and (tramp-get-connection-property v "direct-async-process" nil) + (= (length (tramp-compute-multi-hops v)) 1) + (not (plist-get args :stderr))))) + ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. (defun tramp-handle-make-process (&rest args) - "An alternative `make-process' implementation for Tramp files." + "An alternative `make-process' implementation for Tramp files. +It does not support `:stderr'." (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let ((name (plist-get args :name)) (buffer (plist-get args :buffer)) (command (plist-get args :command)) + ;; FIXME: `:coding' shall be used. (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) + ;; FIXME: `:connection-type' shall be used. (connection-type (plist-get args :connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) @@ -3667,11 +3775,12 @@ User is always nil." (signal 'wrong-type-argument (list #'functionp filter))) (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (null stderr) (bufferp stderr) (stringp stderr)) - (signal 'wrong-type-argument (list #'stringp stderr))) - (when (and (stringp stderr) (tramp-tramp-file-p stderr) - (not (tramp-equal-remote default-directory stderr))) - (signal 'file-error (list "Wrong stderr" stderr))) + (when stderr + (signal + 'user-error + (list + "Stderr not supported for direct remote asynchronous processes" + stderr))) (let* ((buffer (if buffer @@ -3698,9 +3807,12 @@ User is always nil." (tramp-set-connection-property v "process-name" name) (tramp-set-connection-property v "process-buffer" buffer) + ;; Check for `tramp-sh-file-name-handler', because something + ;; is different between tramp-adb.el and tramp-sh.el. (with-current-buffer (tramp-get-connection-buffer v) (unwind-protect - (let* ((login-program + (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v)) + (login-program (tramp-get-method-parameter v 'tramp-login-program)) (login-args (tramp-get-method-parameter v 'tramp-login-args)) @@ -3716,12 +3828,12 @@ User is always nil." ;; in the main connection process, therefore ;; we cannot use `tramp-get-connection-process'. (tmpfile - (when (tramp-sh-file-name-handler-p v) + (when sh-file-name-handler-p (with-tramp-connection-property (tramp-get-process v) "temp-file" (tramp-compat-make-temp-name)))) (options - (when (tramp-sh-file-name-handler-p v) + (when sh-file-name-handler-p (tramp-compat-funcall 'tramp-ssh-controlmaster-options v))) spec) @@ -3814,9 +3926,12 @@ support symbolic links." (setq current-buffer-p t) (current-buffer)) (t (get-buffer-create + ;; These variables have been introduced with Emacs 28.1. (if asynchronous - "*Async Shell Command*" - "*Shell Command Output*"))))) + (or (bound-and-true-p shell-command-buffer-name-async) + "*Async Shell Command*") + (or (bound-and-true-p shell-command-buffer-name) + "*Shell Command Output*")))))) (error-buffer (cond ((bufferp error-buffer) error-buffer) diff --git a/lisp/erc/erc-compat.el b/lisp/obsolete/erc-compat.el index 388728b04a0..7ef30d822ff 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/obsolete/erc-compat.el @@ -5,6 +5,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Amin Bandali <bandali@gnu.org> ;; URL: https://www.emacswiki.org/emacs/ERC +;; Obsolete-since: 28.1 ;; This file is part of GNU Emacs. @@ -43,12 +44,12 @@ Return the same string, if the encoding operation is trivial. See `erc-encoding-coding-alist'." (encode-coding-string s coding-system t)) -(defalias 'erc-propertize 'propertize) -(defalias 'erc-view-mode-enter 'view-mode-enter) +(define-obsolete-function-alias 'erc-propertize #'propertize "28.1") +(define-obsolete-function-alias 'erc-view-mode-enter #'view-mode-enter "28.1") (autoload 'help-function-arglist "help-fns") -(defalias 'erc-function-arglist 'help-function-arglist) -(defalias 'erc-delete-dups 'delete-dups) -(defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string) +(define-obsolete-function-alias 'erc-function-arglist #'help-function-arglist "28.1") +(define-obsolete-function-alias 'erc-delete-dups #'delete-dups "28.1") +(define-obsolete-function-alias 'erc-replace-regexp-in-string #'replace-regexp-in-string "28.1") (defun erc-set-write-file-functions (new-val) (set (make-local-variable 'write-file-functions) new-val)) diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index 2fba49f402d..cbe453aa6bf 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -37,6 +37,7 @@ ;; Special thanks to Rod Smith for many useful bug reports. ;;; Code: +;;; Options (defgroup longlines nil "Automatic wrapping of long lines when loading files." @@ -76,7 +77,7 @@ This is used when `longlines-show-hard-newlines' is on." :group 'longlines :type 'string) -;; Internal variables +;;; Internal variables (defvar longlines-wrap-beg nil) (defvar longlines-wrap-end nil) @@ -90,7 +91,7 @@ This is used when `longlines-show-hard-newlines' is on." (make-variable-buffer-local 'longlines-showing) (make-variable-buffer-local 'longlines-decoded) -;; Mode +;;; Mode (defvar message-indent-citation-function) @@ -210,7 +211,7 @@ This function exists to be called by `change-major-mode-hook' when the major mode changes." (longlines-mode 0)) -;; Showing the effect of hard newlines in the buffer +;;; Showing the effect of hard newlines in the buffer (defun longlines-show-hard-newlines (&optional arg) "Make hard newlines visible by adding a face. @@ -252,7 +253,7 @@ With optional argument ARG, make the hard newlines invisible again." (setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil))) (restore-buffer-modified-p mod))) -;; Wrapping the paragraphs. +;;; Wrapping the paragraphs (defun longlines-wrap-region (beg end) "Wrap each successive line, starting with the line before BEG. @@ -402,7 +403,7 @@ Hard newlines are left intact." (setq pos (string-match "\n" str (1+ pos)))) str)) -;; Auto wrap +;;; Auto wrap (defun longlines-auto-wrap (&optional arg) "Toggle automatic line wrapping. @@ -457,7 +458,7 @@ This is called by `window-configuration-change-hook'." (setq fill-column (- (window-width) dw)) (longlines-wrap-region (point-min) (point-max))))) -;; Isearch +;;; Isearch (defun longlines-search-function () (cond @@ -477,7 +478,7 @@ This is called by `window-configuration-change-hook'." (let ((search-spaces-regexp " *[ \n]")) (re-search-forward string bound noerror count))) -;; Loading and saving +;;; Loading and saving (defun longlines-before-revert-hook () (add-hook 'after-revert-hook 'longlines-after-revert-hook nil t) @@ -492,7 +493,7 @@ This is called by `window-configuration-change-hook'." (list 'longlines "Automatically wrap long lines." nil nil 'longlines-encode-region t nil)) -;; Unloading +;;; Unloading (defun longlines-unload-function () "Unload the longlines library." diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el index d71f79c87be..0de7aa096d6 100644 --- a/lisp/obsolete/tpu-edt.el +++ b/lisp/obsolete/tpu-edt.el @@ -287,14 +287,6 @@ ;;; ;;; User Configurable Variables ;;; -(defcustom tpu-have-ispell t - "Non-nil means `tpu-spell-check' uses `ispell-region' for spell checking. -Otherwise, use `spell-region'." - :type 'boolean - :group 'tpu) -(make-obsolete-variable 'tpu-have-ispell "the `spell' package is obsolete." - "23.1") - (defcustom tpu-kill-buffers-silently nil "If non-nil, TPU-edt kills modified buffers without asking." :type 'boolean @@ -315,7 +307,6 @@ Otherwise, use `spell-region'." ;;; Global Keymaps ;;; -(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1") (defvar tpu-gold-map (let ((map (make-keymap))) ;; Previously we used escape sequences here. We now instead presume @@ -892,8 +883,7 @@ With argument, fill and justify." if no region is selected." (interactive) (let ((m (tpu-mark))) - (apply (if tpu-have-ispell 'ispell-region - 'spell-region) + (apply 'ispell-region (if m (if (> m (point)) (list (point) m) (list m (point))) diff --git a/lisp/outline.el b/lisp/outline.el index 28ea8a86e6f..6158ed594e9 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -289,12 +289,19 @@ Turning on outline mode calls the value of `text-mode-hook' and then of (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) (add-hook 'change-major-mode-hook 'outline-show-all nil t)) +(defvar outline-minor-mode-map) + (defcustom outline-minor-mode-prefix "\C-c@" "Prefix key to use for Outline commands in Outline minor mode. The value of this variable is checked as part of loading Outline mode. After that, changing the prefix key requires manipulating keymaps." - :type 'string - :group 'outlines) + :type 'key-sequence + :group 'outlines + :initialize 'custom-initialize-default + :set (lambda (sym val) + (define-key outline-minor-mode-map outline-minor-mode-prefix nil) + (define-key outline-minor-mode-map val outline-mode-prefix-map) + (set-default sym val))) ;;;###autoload (define-minor-mode outline-minor-mode diff --git a/lisp/password-cache.el b/lisp/password-cache.el index f5007579a8a..2443f374a84 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -94,22 +94,6 @@ The variable `password-cache' control whether the cache is used." (or (password-read-from-cache key) (read-passwd prompt))) -(defun password-read-and-add (prompt &optional key) - "Read password, for use with KEY, from user, or from cache if wanted. -Then store the password in the cache. Uses `password-read' and -`password-cache-add'. Custom variables `password-cache' and -`password-cache-expiry' regulate cache behavior. - -Warning: the password is cached without checking that it is -correct. It is better to check the password before caching. If -you must use this function, take care to check passwords and -remove incorrect ones from the cache." - (declare (obsolete password-read "23.1")) - (let ((password (password-read prompt key))) - (when (and password key) - (password-cache-add key password)) - password)) - (defun password-cache-remove (key) "Remove password indexed by KEY from password cache. This is typically run by a timer setup from `password-cache-add', diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index e5982573792..903c0686063 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -976,16 +976,14 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (* image-vert-size (bubbles--grid-height))) 2))))) -(defun bubbles--remove-overlays () - "Remove all overlays." - (if (fboundp 'remove-overlays) - (remove-overlays))) +(define-obsolete-function-alias 'bubbles--remove-overlays + 'remove-overlays "28.1") (defun bubbles--initialize () "Initialize Bubbles game." (bubbles--initialize-faces) (bubbles--initialize-images) - (bubbles--remove-overlays) + (remove-overlays) (switch-to-buffer (get-buffer-create "*bubbles*")) (bubbles--compute-offsets) @@ -1409,7 +1407,7 @@ Return t if new char is non-empty." (defun bubbles--show-images () "Update images in the bubbles buffer." - (bubbles--remove-overlays) + (remove-overlays) (if (and (display-images-p) bubbles--images-ok (not (eq bubbles-graphics-theme 'ascii))) diff --git a/lisp/play/snake.el b/lisp/play/snake.el index d7c0683a05f..70d80c464fc 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -192,6 +192,7 @@ and then start moving it leftwards.") (defvar snake-null-map (let ((map (make-sparse-keymap 'snake-null-map))) (define-key map "n" 'snake-start-game) + (define-key map "q" 'quit-window) map) "Keymap for finished Snake games.") diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c3a98d9c5cf..7b8b174c430 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -384,7 +384,7 @@ comment at the start of cc-engine.el for more info." c-macro-cache-syntactic nil c-macro-cache-no-comment nil)) (save-match-data - (let ((safe-pos (point))) ; a point ouside any literal. + (let ((safe-pos (point))) ; a point outside any literal. ;; Move over stuff followed by a multiline block comment lacking ;; escaped newlines each time around this loop. (while diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index a76a3c44a35..a043bbcfa3c 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -316,8 +316,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (gcc-include "^\\(?:In file included \\| \\|\t\\)from \ \\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\ -\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?" - 1 2 3 (4 . 5)) +\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\([:,]\\|$\\)\\)?" + 1 2 3 (nil . 4)) (ruby-Test::Unit "^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2) @@ -2373,12 +2373,10 @@ and runs `compilation-filter-hook'." (set-marker min nil) (set-marker max nil)))))) -;;; test if a buffer is a compilation buffer, assuming we're in the buffer (defsubst compilation-buffer-internal-p () "Test if inside a compilation buffer." (local-variable-p 'compilation-locs)) -;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p (defsubst compilation-buffer-p (buffer) "Test if BUFFER is a compilation buffer." (with-current-buffer buffer @@ -2419,12 +2417,9 @@ and runs `compilation-filter-hook'." &optional object limit) (let (parsed res) (while (progn - ;; We parse the buffer here "on-demand" by chunks of 500 chars. - ;; But we could also just parse the whole buffer. (compilation--ensure-parse (setq parsed (max compilation--parsed - (min (+ position 500) - (or limit (point-max)))))) + (or limit (point-max))))) (and (or (not (setq res (next-single-property-change position prop object limit))) (eq res limit)) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5ecd5668b34..2d2713a36ab 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3979,6 +3979,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) + ;; { $a++ / $b } doesn't start a regex, nor does $a-- + (not (and (memq (preceding-char) '(?+ ?-)) + (eq (preceding-char) (char-before (1- (point)))))) ;; m|blah| ? foo : bar; (not (and (eq c ?\?) @@ -5753,7 +5756,7 @@ indentation and initial hashes. Behaves usually outside of comment." (if (eq (char-after (match-beginning 2)) ?%) 'cperl-hash-face 'cperl-array-face) - t) ; arrays and hashes + nil) ; arrays and hashes ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" 1 (if (= (- (match-end 2) (match-beginning 2)) 1) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 08cf802bcbe..22c70bf734d 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -4527,7 +4527,7 @@ end (let* ((ebnf-tree tree) (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p - (float (car (ps-color-values "white"))) + (float (car (color-values "white"))) 1.0)) (ebnf-total (length ebnf-tree)) (ebnf-nprod 0) @@ -4629,7 +4629,7 @@ end (let* ((ebnf-tree tree) (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p - (float (car (ps-color-values "white"))) + (float (car (color-values "white"))) 1.0)) ps-zebra-stripes ps-line-number ps-razzle-dazzle ps-print-hook diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 2f44118edb5..21ba42a0fe1 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1420,10 +1420,12 @@ Intended for `eldoc-documentation-functions' (which see)." (defun elisp-eldoc-var-docstring (callback &rest _ignored) "Document variable at point. Intended for `eldoc-documentation-functions' (which see)." - (let ((sym (elisp--current-symbol))) - (when sym (funcall callback (elisp-get-var-docstring sym) - :thing sym - :face 'font-lock-variable-name-face)))) + (let* ((sym (elisp--current-symbol)) + (docstring (and sym (elisp-get-var-docstring sym)))) + (when docstring + (funcall callback docstring + :thing sym + :face 'font-lock-variable-name-face)))) (defun elisp-get-fnsym-args-string (sym &optional index) "Return a string containing the parameter list of the function SYM. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index edadbbdafc1..2c5c36504a9 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1424,6 +1424,10 @@ hits the start of file." (goto-func goto-tag-location-function) tag tag-info pt) (forward-line 1) + ;; Exuberant ctags add a line starting with the DEL character; + ;; skip past it. + (when (looking-at "\177") + (forward-line 1)) (while (not (or (eobp) (looking-at "\f"))) ;; We used to use explicit tags when available, but the current goto-func ;; can only handle implicit tags. diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index d3a2308e06b..ec4fd58886a 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -267,7 +267,6 @@ support." (declare-function idlwave-find-class-definition "idlwave") (declare-function idlwave-find-inherited-class "idlwave") (declare-function idlwave-find-struct-tag "idlwave") -(declare-function idlwave-get-buffer-visiting "idlwave") (declare-function idlwave-in-quote "idlwave") (declare-function idlwave-make-full-name "idlwave") (declare-function idlwave-members-only "idlwave") @@ -880,7 +879,7 @@ This function can be used as `idlwave-extra-help-function'." (setq in-buf ; structure-tag completion is always in current buffer (if struct-tag idlwave-current-tags-buffer - (idlwave-get-buffer-visiting file))) + (find-buffer-visiting file))) ;; see if file is in a visited buffer, insert those contents (if in-buf (progn diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 6770fbe8abc..99ac0877c8b 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -2640,7 +2640,7 @@ Assumes that `idlwave-shell-sources-alist' contains an entry for that module." (if (or (not source-file) (not (file-regular-p source-file)) (not (setq buf - (or (idlwave-get-buffer-visiting source-file) + (or (find-buffer-visiting source-file) (find-file-noselect source-file))))) (progn (message "The source file for module %s is probably not compiled" @@ -2745,7 +2745,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command." ;; event. mouse-drag-track does so. (if drag-track 'mouse-drag-track 'mouse-drag-region))) (funcall tracker event) - (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil) + (idlwave-shell-print (if (region-active-p) '(4) nil) ,help ,ev)))) ;; Begin terrible hack section -- XEmacs tests for button2 explicitly @@ -2830,7 +2830,7 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key." (cond ((equal arg '(16)) (setq expr (read-string "Expression: "))) - ((and (or arg (idlwave-region-active-p)) + ((and (or arg (region-active-p)) (< (- (region-end) (region-beginning)) 2000)) (setq beg (region-beginning) end (region-end))) @@ -3241,8 +3241,7 @@ Does not work for a region with multiline blocks - use "Delete the temporary files and kill associated buffers." (if (stringp idlwave-shell-temp-pro-file) (condition-case nil - (let ((buf (idlwave-get-buffer-visiting - idlwave-shell-temp-pro-file))) + (let ((buf (find-buffer-visiting idlwave-shell-temp-pro-file))) (if (buffer-live-p buf) (kill-buffer buf)) (delete-file idlwave-shell-temp-pro-file)) @@ -3788,7 +3787,7 @@ handled by this command." (save-buffer) (setq idlwave-shell-last-save-and-action-file (buffer-file-name))) (idlwave-shell-last-save-and-action-file - (if (setq buf (idlwave-get-buffer-visiting + (if (setq buf (find-buffer-visiting idlwave-shell-last-save-and-action-file)) (with-current-buffer buf (save-buffer)))) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 3092d4c45b0..153f2578bf1 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -154,21 +154,6 @@ (eval-when-compile (require 'cl-lib)) (require 'idlw-help) -;; For XEmacs -(unless (fboundp 'line-beginning-position) - (defalias 'line-beginning-position 'point-at-bol)) -(unless (fboundp 'line-end-position) - (defalias 'line-end-position 'point-at-eol)) -(unless (fboundp 'char-valid-p) - (defalias 'char-valid-p 'characterp)) -(unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties 'match-string)) - -(if (not (fboundp 'cancel-timer)) - (condition-case nil - (require 'timer) - (error nil))) - (declare-function idlwave-shell-get-path-info "idlw-shell") (declare-function idlwave-shell-temp-file "idlw-shell") (declare-function idlwave-shell-is-running "idlw-shell") @@ -596,12 +581,7 @@ like this: MyMethod <Class1,Class2,Class3> The value of this variable may be nil to inhibit display, or an integer to -indicate the maximum number of classes to display. - -On XEmacs, a full list of classes will also be placed into a `help-echo' -property on the completion items, so that the list of classes for the current -item is displayed in the echo area. If the value of this variable is a -negative integer, the `help-echo' property will be suppressed." +indicate the maximum number of classes to display." :group 'idlwave-completion :type '(choice (const :tag "Don't show" nil) (integer :tag "Number of classes shown" 1))) @@ -1069,7 +1049,6 @@ goto Goto Statements common-blocks Common Blocks keyword-parameters Keyword Parameters in routine definitions and calls system-variables System Variables -fixme FIXME: Warning in comments (on XEmacs only v. 21.0 and up) class-arrows Object Arrows with class property" :group 'idlwave-misc :type '(set @@ -1084,7 +1063,6 @@ class-arrows Object Arrows with class property" (const :tag "Common Blocks" common-blocks) (const :tag "Keyword Parameters" keyword-parameters) (const :tag "System Variables" system-variables) - (const :tag "FIXME: Warning" fixme) (const :tag "Object Arrows with class property " class-arrows))) (defcustom idlwave-mode-hook nil @@ -1153,23 +1131,16 @@ As a user, you should not set this to t.") ;; Common blocks (common-blocks '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" - (1 font-lock-keyword-face) ; "common" - (2 font-lock-constant-face nil t) ; block name + (1 font-lock-keyword-face) ; "common" + (2 font-lock-constant-face nil t) ; block name ("[ \t]*\\(\\sw+\\)[ ,]*" ;; Start with point after block name and comma - (goto-char (match-end 0)) ; needed for XEmacs, could be nil - nil - (1 font-lock-variable-name-face) ; variable names - ))) + nil nil (1 font-lock-variable-name-face)))) ; variable names ;; Batch files (batch-files '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face))) - ;; FIXME warning. - (fixme - '("\\<FIXME:" (0 font-lock-warning-face t))) - ;; Labels (label '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face))) @@ -1256,9 +1227,6 @@ As a user, you should not set this to t.") ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) beginning-of-line)) -(put 'idlwave-mode 'font-lock-defaults - idlwave-font-lock-defaults) ; XEmacs - (defconst idlwave-comment-line-start-skip "^[ \t]*;" "Regexp to match the start of a full-line comment. That is the _beginning_ of a line containing a comment delimiter `;' preceded @@ -1494,9 +1462,7 @@ Otherwise ARGS forms a list that is evaluated." (define-key map "\M-\C-i" 'idlwave-complete) (define-key map "\C-c\C-i" 'idlwave-update-routine-info) (define-key map "\C-c=" 'idlwave-resolve) - (define-key map - (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) - 'idlwave-mouse-context-help) + (define-key map [(shift mouse-3)] 'idlwave-mouse-context-help) map) "Keymap used in IDL mode.") @@ -1931,8 +1897,6 @@ The main features of this mode are (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) ;; Font-lock additions - ;; Following line is for Emacs - XEmacs uses the corresponding property - ;; on the `idlwave-mode' symbol. (set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults) (set (make-local-variable 'font-lock-mark-block-function) 'idlwave-mark-subprogram) @@ -2092,11 +2056,7 @@ Returns point if comment found and nil otherwise." (backward-char 1) (point))))) -(defun idlwave-region-active-p () - "Should we operate on an active region?" - (if (fboundp 'use-region-p) - (use-region-p) - (region-active-p))) +(define-obsolete-function-alias 'idlwave-region-active-p 'use-region-p "28.1") (defun idlwave-show-matching-quote () "Insert quote and show matching quote if this is end of a string." @@ -3833,15 +3793,8 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (setq start (match-end 0))) (setq ret_string (concat ret_string (substring string start last))))) -(defun idlwave-get-buffer-visiting (file) - ;; Return the buffer currently visiting FILE - (cond - ((boundp 'find-file-compare-truenames) ; XEmacs - (let ((find-file-compare-truenames t)) - (get-file-buffer file))) - ((fboundp 'find-buffer-visiting) ; Emacs - (find-buffer-visiting file)) - (t (error "This should not happen (idlwave-get-buffer-visiting)")))) +(define-obsolete-function-alias 'idlwave-get-buffer-visiting + #'find-buffer-visiting "28.1") (defvar idlwave-outlawed-buffers nil "List of buffers pulled up by IDLWAVE for special reasons. @@ -3849,7 +3802,7 @@ Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.") (defun idlwave-find-file-noselect (file &optional why) ;; Return a buffer visiting file. - (or (idlwave-get-buffer-visiting file) + (or (find-buffer-visiting file) (let ((buf (find-file-noselect file))) (if why (add-to-list 'idlwave-outlawed-buffers (cons buf why))) buf))) @@ -6637,7 +6590,6 @@ This function is not general, can only be used for completion stuff." "A form to evaluate after completion selection in *Completions* buffer.") (defconst idlwave-completion-mark (make-marker) "A mark pointing to the beginning of the completion string.") -(defvar completion-highlight-first-word-only) ;XEmacs. (defun idlwave-complete-in-buffer (type stype list selector prompt isa &optional prepare-display-function @@ -6716,12 +6668,7 @@ accumulate information on matching completions." list)) (let* ((list all-completions) ;; "complete" means, this is already a valid completion - (complete (memq spart all-completions)) - (completion-highlight-first-word-only t)) ; XEmacs - ;; (completion-fixup-function ; Emacs - ;; (lambda () (and (eq (preceding-char) ?>) - ;; (re-search-backward " <" beg t))))) - + (complete (memq spart all-completions))) (setq list (sort list (lambda (a b) (string< (downcase a) (downcase b))))) (if prepare-display-function @@ -6783,7 +6730,6 @@ accumulate information on matching completions." (let* ((do-prop (and (>= show-classes 0) (>= emacs-major-version 21))) (do-buf (not (= show-classes 0))) - ;; (do-dots (featurep 'xemacs)) (do-dots t) (inherit (if (and (not (eq type 'class-tag)) super-classes) (cons class-selector super-classes))) @@ -6849,10 +6795,6 @@ accumulate information on matching completions." ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- ;;---------------------------------------------------------------------- -(when (featurep 'xemacs) - (defvar rtn) - (defun idlwave-pset (item) - (set 'rtn item))) (defun idlwave-popup-select (ev list title &optional sort) "Select an item in LIST with a popup menu. @@ -6863,17 +6805,6 @@ sort the list before displaying." (cond ((null list)) ((= 1 (length list)) (setq rtn (car list))) - ((featurep 'xemacs) - (if sort (setq list (sort list (lambda (a b) - (string< (upcase a) (upcase b)))))) - (setq menu - (append (list title) - (mapcar (lambda (x) (vector x (list 'idlwave-pset - x))) - list))) - (setq menu (idlwave-split-menu-xemacs menu maxpopup)) - (let ((resp (get-popup-menu-response menu))) - (funcall (event-function resp) (event-object resp)))) (t (if sort (setq list (sort list (lambda (a b) (string< (upcase a) (upcase b)))))) @@ -6881,36 +6812,14 @@ sort the list before displaying." (list (append (list "") (mapcar (lambda(x) (cons x x)) list))))) - (setq menu (idlwave-split-menu-emacs menu maxpopup)) + (setq menu (idlwave-split-menu menu maxpopup)) (setq rtn (x-popup-menu ev menu)))) rtn)) -(defun idlwave-split-menu-xemacs (menu N) - "Split the MENU into submenus of maximum length N." - (if (<= (length menu) (1+ N)) - ;; No splitting needed - menu - (let* ((title (car menu)) - (entries (cdr menu)) - (menu (list title)) - (cnt 0) - (nextmenu nil)) - (while entries - (while (and entries (< cnt N)) - (setq cnt (1+ cnt) - nextmenu (cons (car entries) nextmenu) - entries (cdr entries))) - (setq nextmenu (nreverse nextmenu)) - (setq nextmenu (cons (format "%s...%s" - (aref (car nextmenu) 0) - (aref (nth (1- cnt) nextmenu) 0)) - nextmenu)) - (setq menu (cons nextmenu menu) - nextmenu nil - cnt 0)) - (nreverse menu)))) +(define-obsolete-function-alias 'idlwave-split-menu-emacs + #'idlwave-split-menu "28.1") -(defun idlwave-split-menu-emacs (menu N) +(defun idlwave-split-menu (menu N) "Split the MENU into submenus of maximum length N." (if (<= (length (nth 1 menu)) (1+ N)) ;; No splitting needed @@ -6965,10 +6874,7 @@ sort the list before displaying." (move-marker idlwave-completion-mark beg) (setq idlwave-before-completion-wconf (current-window-configuration))) - (if (featurep 'xemacs) - (idlwave-display-completion-list-xemacs - list) - (idlwave-display-completion-list-emacs list)) + (idlwave-display-completion-list-1 list) ;; Store a special value in `this-command'. When `idlwave-complete' ;; finds this in `last-command', it will scroll the *Completions* buffer. @@ -7026,8 +6932,7 @@ The key which is associated with each option is generated automatically. First, the strings are checked for preselected keys, like in \"[P]rint\". If these don't exist, a letter in the string is automatically selected." (let* ((alist (symbol-value sym)) - (temp-buffer-show-hook (if (fboundp 'fit-window-to-buffer) - '(fit-window-to-buffer))) + (temp-buffer-show-hook '(fit-window-to-buffer)) keys-alist char) ;; First check the cache (if (and (eq (symbol-value sym) (get sym :one-key-alist-last))) @@ -7113,42 +7018,17 @@ If these don't exist, a letter in the string is automatically selected." (and (local-variable-p var (current-buffer)) (symbol-value var)))) -;; In XEmacs, we can use :activate-callback directly to advice the -;; choose functions. We use the private keymap only for the online -;; help feature. - (defvar idlwave-completion-map nil "Keymap for `completion-list-mode' with `idlwave-complete'.") -(defun idlwave-display-completion-list-xemacs (list &rest cl-args) - (with-output-to-temp-buffer "*Completions*" - (apply 'display-completion-list list - ':activate-callback 'idlwave-default-choose-completion - cl-args)) - (with-current-buffer "*Completions*" - (use-local-map - (or idlwave-completion-map - (setq idlwave-completion-map - (idlwave-make-modified-completion-map-xemacs - (current-local-map))))))) - (defun idlwave-default-choose-completion (&rest args) "Execute `default-choose-completion' and then restore the win-conf." (apply 'idlwave-choose 'default-choose-completion args)) -(defun idlwave-make-modified-completion-map-xemacs (old-map) - "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." - (let ((new-map (copy-keymap old-map))) - (define-key new-map [button3up] 'idlwave-mouse-completion-help) - (define-key new-map [button3] (lambda () - (interactive) - (setq this-command last-command))) - new-map)) - -;; In Emacs we also replace keybindings in the completion -;; map in order to install our wrappers. +(define-obsolete-function-alias 'idlwave-display-completion-list-emacs + #'idlwave-display-completion-list-1 "28.1") -(defun idlwave-display-completion-list-emacs (list) +(defun idlwave-display-completion-list-1 (list) "Display completion list and install the choose wrappers." (with-output-to-temp-buffer "*Completions*" (display-completion-list list)) @@ -7156,10 +7036,12 @@ If these don't exist, a letter in the string is automatically selected." (use-local-map (or idlwave-completion-map (setq idlwave-completion-map - (idlwave-make-modified-completion-map-emacs - (current-local-map))))))) + (idlwave-make-modified-completion-map (current-local-map))))))) -(defun idlwave-make-modified-completion-map-emacs (old-map) +(define-obsolete-function-alias 'idlwave-make-modified-completion-map-emacs + #'idlwave-make-modified-completion-map "28.1") + +(defun idlwave-make-modified-completion-map (old-map) "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." (let ((new-map (copy-keymap old-map))) (substitute-key-definition @@ -7371,7 +7253,7 @@ class/struct definition." (file (idlwave-routine-source-file (nth 3 (idlwave-rinfo-assoc pro 'pro nil (idlwave-routines)))))) - (cons file (if file (idlwave-get-buffer-visiting file))))) + (cons file (if file (find-buffer-visiting file))))) (defun idlwave-scan-class-info (class) @@ -8242,15 +8124,9 @@ If we do not know about MODULE, just return KEYWORD literally." (defvar idlwave-rinfo-mouse-map (let ((map (make-sparse-keymap))) - (define-key map - (if (featurep 'xemacs) [button2] [mouse-2]) - 'idlwave-mouse-active-rinfo) - (define-key map - (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) - 'idlwave-mouse-active-rinfo-shift) - (define-key map - (if (featurep 'xemacs) [button3] [mouse-3]) - 'idlwave-mouse-active-rinfo-right) + (define-key map [mouse-2] 'idlwave-mouse-active-rinfo) + (define-key map [(shift mouse-2)] 'idlwave-mouse-active-rinfo-shift) + (define-key map [mouse-3] 'idlwave-mouse-active-rinfo-right) (define-key map " " 'idlwave-active-rinfo-space) (define-key map "q" 'idlwave-quit-help) map)) @@ -8302,7 +8178,6 @@ If we do not know about MODULE, just return KEYWORD literally." "Button2: Display info about same method in superclass") (col 0) (data (list name type class (current-buffer) nil initial-class)) - (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) (face 'idlwave-help-link) beg props win cnt total) ;; Fix keywords, but don't add chained super-classes, since these @@ -8327,7 +8202,7 @@ If we do not know about MODULE, just return KEYWORD literally." idlwave-current-obj_new-class) (when superclasses (setq props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'help-echo help-echo-class 'data (cons 'class data))) (let ((classes (cons initial-class superclasses)) c) @@ -8343,7 +8218,7 @@ If we do not know about MODULE, just return KEYWORD literally." (add-text-properties beg (point) props)))) (insert "\n"))) (setq props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'help-echo help-echo-use 'data (cons 'usage data))) (if html-file (setq props (append (list 'face face 'link html-file) @@ -8371,7 +8246,7 @@ If we do not know about MODULE, just return KEYWORD literally." (setq beg (point) ;; Relevant keywords already have link property attached props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'data (cons 'keyword data) 'help-echo help-echo-kwd 'keyword (car x))) @@ -8385,7 +8260,7 @@ If we do not know about MODULE, just return KEYWORD literally." ;; Here entry is (key file (list of type-conses)) (while (setq entry (pop all)) (setq props (list 'mouse-face 'highlight - km-prop idlwave-rinfo-mouse-map + 'local-map idlwave-rinfo-mouse-map 'help-echo help-echo-src 'source (list (car (car (nth 2 entry))) ;type (nth 1 entry) @@ -8490,8 +8365,7 @@ to it." (add-text-properties beg (point) (list 'face 'bold))) (when (and file (not (equal file ""))) (setq beg (point)) - (insert (apply 'abbreviate-file-name - (if (featurep 'xemacs) (list file t) (list file)))) + (insert (apply 'abbreviate-file-name (list file))) (if file-props (add-text-properties beg (point) file-props))))) @@ -8651,10 +8525,9 @@ can be used to detect possible name clashes during this process." idlwave-user-catalog-routines idlwave-buffer-routines nil)) - (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) (keymap (make-sparse-keymap)) (props (list 'mouse-face 'highlight - km-prop keymap + 'local-map keymap 'help-echo "Mouse2: Find source")) (nroutines (length (or special-routines routines))) (step (/ nroutines 100)) @@ -8677,7 +8550,7 @@ can be used to detect possible name clashes during this process." (nth 2 b) (car b))))))) (message "Sorting routines...done") - (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) + (define-key keymap [(mouse-2)] (lambda (ev) (interactive "e") (mouse-set-point ev) @@ -9039,23 +8912,6 @@ Assumes that point is at the beginning of the unit as found by 'imenu) (error nil))))) -;; Here we hack func-menu.el in order to support this new mode. -;; The latest versions of func-menu.el already have this stuff in, so -;; we hack only if it is not already there. -(when (featurep 'xemacs) - (eval-after-load "func-menu" - '(progn - (or (assq 'idlwave-mode fume-function-name-regexp-alist) - (not (boundp 'fume-function-name-regexp-idl)) ; avoid problems - (setq fume-function-name-regexp-alist - (cons '(idlwave-mode . fume-function-name-regexp-idl) - fume-function-name-regexp-alist))) - (or (assq 'idlwave-mode fume-find-function-name-method-alist) - (not (fboundp 'fume-find-next-idl-function-name)) ; avoid problems - (setq fume-find-function-name-method-alist - (cons '(idlwave-mode . fume-find-next-idl-function-name) - fume-find-function-name-method-alist)))))) - (defun idlwave-edit-in-idlde () "Edit the current file in IDL Development environment." (interactive) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index ff0b6a331bc..127b24cb890 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -214,7 +214,9 @@ (defconst perl--syntax-exp-intro-regexp (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" (regexp-opt perl--syntax-exp-intro-keywords) - "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*"))) + "\\|[?:.,;|&*=!~({[]" + "\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't! + "\\|\\(^\\)\\)[ \t\n]*"))) (defun perl-syntax-propertize-function (start end) (let ((case-fold-search nil)) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index b6161351f0b..8afd5ce7959 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,8 +1,8 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. -;; Version: 0.5.0 -;; Package-Requires: ((emacs "26.3")) +;; Version: 0.5.1 +;; Package-Requires: ((emacs "26.3") (xref "1.0.2")) ;; This is a GNU ELPA :core package. Avoid using functionality that ;; not compatible with the version of Emacs recorded above. @@ -731,24 +731,6 @@ pattern to search for." (user-error "No matches for: %s" regexp)) xrefs)) -(defun project--process-file-region (start end program - &optional buffer display - &rest args) - ;; FIXME: This branching shouldn't be necessary, but - ;; call-process-region *is* measurably faster, even for a program - ;; doing some actual work (for a period of time). Even though - ;; call-process-region also creates a temp file internally - ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). - (if (not (file-remote-p default-directory)) - (apply #'call-process-region - start end program nil buffer display args) - (let ((infile (make-temp-file "ppfr"))) - (unwind-protect - (progn - (write-region start end infile nil 'silent) - (apply #'process-file program infile buffer display args)) - (delete-file infile))))) - (defun project--read-regexp () (let ((sym (thing-at-point 'symbol))) (read-regexp "Find regexp" (and sym (regexp-quote sym))))) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 99b57354e25..a209d21807f 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -271,10 +271,6 @@ (require 'easymenu) (require 'align) -(eval-when-compile - (or (fboundp 'use-region-p) - (defsubst use-region-p () (region-exists-p)))) - (defgroup prolog nil "Editing and running Prolog and Mercury files." :group 'languages) @@ -2752,20 +2748,6 @@ When called with prefix argument ARG, disable zipping instead." (nth 1 state))) )))) -;; For backward compatibility. Stolen from custom.el. -(or (fboundp 'match-string) - ;; Introduced in Emacs 19.29. - (defun match-string (num &optional string) - "Return string of text matched by last search. -NUM specifies which parenthesized expression in the last regexp. - Value is nil if NUMth pair didn't match, or there were less than NUM pairs. -Zero means the entire text matched by the whole regexp or whole string. -STRING should be given if the last search was by `string-match' on STRING." - (if (match-beginning num) - (if string - (substring string (match-beginning num) (match-end num)) - (buffer-substring (match-beginning num) (match-end num)))))) - (defun prolog-pred-start () "Return the starting point of the first clause of the current predicate." ;; FIXME: Use SMIE. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3af55be4a19..d83af83b32e 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -283,24 +283,6 @@ :link '(emacs-commentary-link "python")) -;;; 24.x Compat - - -(eval-and-compile - (unless (fboundp 'prog-first-column) - (defun prog-first-column () - 0)) - (unless (fboundp 'file-local-name) - (defun file-local-name (file) - "Return the local name component of FILE. -It returns a file name which can be used directly as argument of -`process-file', `start-file-process', or `shell-command'." - (or (file-remote-p file 'localname) file)))) - -;; In Emacs 24.3 and earlier, `define-derived-mode' does not define -;; the hook variable, it only puts documentation on the symbol. -(defvar inferior-python-mode-hook) - ;;; Bindings @@ -2809,6 +2791,7 @@ variable. python-shell-comint-watch-for-first-prompt-output-filter python-comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)) + (setq-local comint-highlight-input nil) (set (make-local-variable 'compilation-error-regexp-alist) python-shell-compilation-regexp-alist) (add-hook 'completion-at-point-functions diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index c86fc59ac16..e554b2b8b0b 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -455,7 +455,7 @@ file. Since that is a plaintext file, this could be dangerous." :prompt-regexp "^mysql> " :prompt-length 6 :prompt-cont-regexp "^ -> " - :syntax-alist ((?# . "< b")) + :syntax-alist ((?# . "< b") (?\\ . "\\")) :input-filter sql-remove-tabs-filter) (oracle @@ -4187,7 +4187,7 @@ must tell Emacs. Here's how to do that in your init file: \(add-hook \\='sql-mode-hook (lambda () - (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))" + (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))" :abbrev-table sql-mode-abbrev-table (if sql-mode-menu @@ -4210,6 +4210,18 @@ must tell Emacs. Here's how to do that in your init file: (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (set (make-local-variable 'sql-contains-names) t) + (setq-local syntax-propertize-function + (syntax-propertize-rules + ;; Handle escaped apostrophes within strings. + ("''" + (0 + (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + (forward-char -1) + nil))) + ;; Propertize rules to not have /- and -* start comments. + ("\\(/-\\)" (1 ".")) + ("\\(-\\*\\)" (1 ".")))) ;; Set syntax and font-face highlighting ;; Catch changes to sql-product and highlight accordingly (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index f9b069fd4e5..0f2c9431f6e 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -115,6 +115,8 @@ treat nomenclature boundaries as word boundaries." (when subword-mode (superword-mode -1)) (subword-setup-buffer)) +;; This is defined also in cc-cmds.el, but as obsolete since 24.3. +;; Let's keep this until the other one can also be removed. (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2") ;;;###autoload diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 3e3a37f6da5..bbf899e7017 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,8 +1,8 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2020 Free Software Foundation, Inc. -;; Version: 1.0.1 -;; Package-Requires: ((emacs "26.3") (project "0.1.1")) +;; Version: 1.0.2 +;; Package-Requires: ((emacs "26.3")) ;; This is a GNU ELPA :core package. Avoid functionality that is not ;; compatible with the version of Emacs recorded above. @@ -263,13 +263,16 @@ be found, return nil. The default implementation uses `semantic-symref-tool-alist' to find a search tool; by default, this uses \"find | grep\" in the -`project-current' roots." +current project's main and external roots." (mapcan (lambda (dir) (xref-references-in-directory identifier dir)) (let ((pr (project-current t))) (cons - (project-root pr) + (if (fboundp 'project-root) + (project-root pr) + (with-no-warnings + (project-roots pr))) (project-external-roots pr))))) (cl-defgeneric xref-backend-apropos (backend pattern) @@ -1281,13 +1284,13 @@ FILES must be a list of absolute file names." (insert (mapconcat #'identity files "\0")) (setq default-directory dir) (setq status - (project--process-file-region (point-min) - (point-max) - shell-file-name - output - nil - shell-command-switch - command))) + (xref--process-file-region (point-min) + (point-max) + shell-file-name + output + nil + shell-command-switch + command))) (goto-char (point-min)) (when (and (/= (point-min) (point-max)) (not (looking-at grep-re)) @@ -1302,6 +1305,24 @@ FILES must be a list of absolute file names." hits))) (xref--convert-hits (nreverse hits) regexp))) +(defun xref--process-file-region ( start end program + &optional buffer display + &rest args) + ;; FIXME: This branching shouldn't be necessary, but + ;; call-process-region *is* measurably faster, even for a program + ;; doing some actual work (for a period of time). Even though + ;; call-process-region also creates a temp file internally + ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). + (if (not (file-remote-p default-directory)) + (apply #'call-process-region + start end program nil buffer display args) + (let ((infile (make-temp-file "ppfr"))) + (unwind-protect + (progn + (write-region start end infile nil 'silent) + (apply #'process-file program infile buffer display args)) + (delete-file infile))))) + (defun xref--rgrep-command (regexp files dir ignores) (require 'find-dired) ; for `find-name-arg' (defvar grep-find-template) diff --git a/lisp/ps-def.el b/lisp/ps-def.el index 49d72d3be50..65e8011f771 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -55,24 +55,14 @@ (face-background face nil t)) -(defalias 'ps-frame-parameter 'frame-parameter) +(define-obsolete-function-alias 'ps-frame-parameter #'frame-parameter "28.1") ;; Return t if the device (which can be changed during an emacs session) can -;; handle colors. This function is not yet implemented for GNU emacs. +;; handle colors. (defun ps-color-device () - (if (fboundp 'color-values) - (funcall 'color-values "Green") - t)) - - -(defun ps-color-values (x-color) - (cond - ((fboundp 'color-values) - (funcall 'color-values x-color)) - ((fboundp 'x-color-values) - (funcall 'x-color-values x-color)) - (t - (error "No available function to determine X color values")))) + (color-values "Green")) + +(define-obsolete-function-alias 'ps-color-values #'color-values "28.1") (defun ps-face-bold-p (face) diff --git a/lisp/ps-print.el b/lisp/ps-print.el index ace30017814..1ca4a23ab2c 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -3856,7 +3856,7 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'." (defun ps-color-scale (color) ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. (mapcar #'(lambda (value) (/ value ps-print-color-scale)) - (ps-color-values color))) + (color-values color))) (defun ps-face-underlined-p (face) @@ -5752,7 +5752,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") ;; evaluated at dump-time because X isn't initialized. ps-color-p (and ps-print-color-p (ps-color-device)) ps-print-color-scale (if ps-color-p - (float (car (ps-color-values "white"))) + (float (car (color-values "white"))) 1.0) ps-default-background (ps-rgb-color (cond @@ -5761,7 +5761,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-bg 'frame-parameter) - (ps-frame-parameter nil 'background-color)) + (frame-parameter nil 'background-color)) ((eq ps-default-bg t) (ps-face-background-name 'default)) (t @@ -5775,7 +5775,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-fg 'frame-parameter) - (ps-frame-parameter nil 'foreground-color)) + (frame-parameter nil 'foreground-color)) ((eq ps-default-fg t) (ps-face-foreground-name 'default)) (t @@ -6275,10 +6275,6 @@ If FACE is not a valid face name, use default face." (goto-char to)) -;; Ensure that face-list is fbound. -(or (fboundp 'face-list) (defalias 'face-list 'list-faces)) - - (defun ps-build-reference-face-lists () (setq ps-print-face-alist nil) (if ps-auto-font-detect diff --git a/lisp/recentf.el b/lisp/recentf.el index 27918a9739c..877edd4be1f 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1289,7 +1289,8 @@ Write data into the file specified by `recentf-save-file'." (insert "\n \n;; Local Variables:\n" (format ";; coding: %s\n" recentf-save-file-coding-system) ";; End:\n") - (write-file (expand-file-name recentf-save-file)) + (write-region (point-min) (point-max) + (expand-file-name recentf-save-file)) (when recentf-save-file-modes (set-file-modes recentf-save-file recentf-save-file-modes)) nil) diff --git a/lisp/savehist.el b/lisp/savehist.el index fcfdb47c7e8..4e52efe7f1a 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -4,7 +4,7 @@ ;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com> ;; Maintainer: emacs-devel@gnu.org -;; Keywords: minibuffer +;; Keywords: convenience, minibuffer ;; Version: 24 ;; This file is part of GNU Emacs. @@ -27,7 +27,7 @@ ;; Many editors (e.g. Vim) have the feature of saving minibuffer ;; history to an external file after exit. This package provides the ;; same feature in Emacs. When set up, it saves recorded minibuffer -;; histories to a file (`~/.emacs-history' by default). Additional +;; histories to a file (`~/.emacs.d/history' by default). Additional ;; variables may be specified by customizing ;; `savehist-additional-variables'. diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 46738ab03dc..d420bfb4e9f 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -1,4 +1,4 @@ -;;; saveplace.el --- automatically save place in files +;;; saveplace.el --- automatically save place in files -*- lexical-binding:t -*- ;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc. @@ -42,7 +42,6 @@ "Automatically save place in files." :group 'data) - (defvar save-place-alist nil "Alist of saved places to go back to when revisiting files. Each element looks like (FILENAME . POSITION); @@ -175,10 +174,11 @@ file: (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) (defun save-place-to-alist () - ;; put filename and point in a cons box and then cons that onto the - ;; front of the save-place-alist, if save-place-mode is non-nil. - ;; Otherwise, just delete that file from the alist. - ;; first check to make sure alist has been loaded in from the master + "Add current buffer filename and position to `save-place-alist'. +Put filename and point in a cons box and then cons that onto the +front of the `save-place-alist', if `save-place-mode' is non-nil. +Otherwise, just delete that file from the alist." + ;; First check to make sure alist has been loaded in from the master ;; file. If not, do so, then feel free to modify the alist. It ;; will be saved again when Emacs is killed. (or save-place-loaded (load-save-place-alist-from-file)) diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el index 3a6d9d36429..f20ea1bcc87 100644 --- a/lisp/scroll-lock.el +++ b/lisp/scroll-lock.el @@ -1,4 +1,4 @@ -;;; scroll-lock.el --- Scroll lock scrolling. +;;; scroll-lock.el --- Scroll lock scrolling. -*- lexical-binding:t -*- ;; Copyright (C) 2005-2020 Free Software Foundation, Inc. diff --git a/lisp/server.el b/lisp/server.el index 18612181477..9934e1c1be9 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -274,10 +274,11 @@ the \"-f\" switch otherwise." (if internal--daemon-sockname (file-name-directory internal--daemon-sockname) (and (featurep 'make-network-process '(:family local)) - (let ((xdg_runtime_dir (getenv "XDG_RUNTIME_DIR"))) - (if xdg_runtime_dir - (format "%s/emacs" xdg_runtime_dir) - (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid)))))) + (let ((runtime-dir (getenv "XDG_RUNTIME_DIR"))) + (if runtime-dir + (expand-file-name "emacs" runtime-dir) + (expand-file-name (format "emacs%d" (user-uid)) + (or (getenv "TMPDIR") "/tmp")))))) "The directory in which to place the server socket. If local sockets are not supported, this is nil.") diff --git a/lisp/shell.el b/lisp/shell.el index dc528412a62..9667dab2afd 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -619,7 +619,12 @@ buffer." ;; Bypass a bug in certain versions of bash. (when (string-equal shell "bash") (add-hook 'comint-preoutput-filter-functions - #'shell-filter-ctrl-a-ctrl-b nil t))) + #'shell-filter-ctrl-a-ctrl-b nil t)) + + ;; Skip extended history for zsh. + (when (string-equal shell "zsh") + (setq-local comint-input-ring-file-prefix + ": [[:digit:]]+:[[:digit:]]+;"))) (comint-read-input-ring t))) (defun shell-apply-ansi-color (beg end face) @@ -985,9 +990,6 @@ this feature; see the function `dirtrack-mode'." (add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t) (remove-hook 'comint-input-filter-functions #'shell-directory-tracker t))) -(define-obsolete-function-alias 'shell-dirtrack-toggle #'shell-dirtrack-mode - "23.1") - (defun shell-cd (dir) "Do normal `cd' to DIR, and set `list-buffers-directory'." (cd dir) @@ -1033,25 +1035,41 @@ command again." (accept-process-output proc) (goto-char pt))) (goto-char pmark) (delete-char 1) ; remove the extra newline - ;; That's the dirlist. grab it & parse it. - (let* ((dl (buffer-substring (match-beginning 2) (1- (match-end 2)))) - (dl-len (length dl)) - (ds '()) ; new dir stack - (i 0)) - (while (< i dl-len) - ;; regexp = optional whitespace, (non-whitespace), optional whitespace - (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir - (setq ds (cons (concat comint-file-name-prefix - (substring dl (match-beginning 1) - (match-end 1))) - ds)) - (setq i (match-end 0))) - (let ((ds (nreverse ds))) - (with-demoted-errors "Couldn't cd: %s" - (shell-cd (car ds)) - (setq shell-dirstack (cdr ds) - shell-last-dir (car shell-dirstack)) - (shell-dirstack-message))))) + ;; That's the dirlist. Grab it & parse it. + (let* ((dls (buffer-substring-no-properties + (match-beginning 0) (1- (match-end 0)))) + (dlsl nil) + (pos 0) + (ds nil)) + ;; Split the dirlist into whitespace and non-whitespace chunks. + ;; dlsl will be a reversed list of tokens. + (while (string-match "\\(\\S-+\\|\\s-+\\)" dls pos) + (push (match-string 1 dls) dlsl) + (setq pos (match-end 1))) + + ;; Prepend trailing entries until they form an existing directory, + ;; whitespace and all. Discard the next whitespace and repeat. + (while dlsl + (let ((newelt "") + tem1 tem2) + (while newelt + ;; We need tem1 because we don't want to prepend + ;; `comint-file-name-prefix' repeatedly into newelt via tem2. + (setq tem1 (pop dlsl) + tem2 (concat comint-file-name-prefix tem1 newelt)) + (cond ((file-directory-p tem2) + (push tem2 ds) + (when (string= " " (car dlsl)) + (pop dlsl)) + (setq newelt nil)) + (t + (setq newelt (concat tem1 newelt))))))) + + (with-demoted-errors "Couldn't cd: %s" + (shell-cd (car ds)) + (setq shell-dirstack (cdr ds) + shell-last-dir (car shell-dirstack)) + (shell-dirstack-message)))) (if started-at-pmark (goto-char (marker-position pmark))))) ;; For your typing convenience: diff --git a/lisp/simple.el b/lisp/simple.el index 2f92238e640..f08015372af 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -247,7 +247,7 @@ from which next-error navigated, and a target buffer TO-BUFFER." extra-test-exclusive) "Try the current buffer when outside navigation. But return nil if we navigated to the current buffer by the means -of `next-error' command. Othewise, return it if it's next-error +of `next-error' command. Otherwise, return it if it's next-error capable." ;; Check that next-error-buffer has no buffer-local value ;; (i.e. we never navigated to the current buffer from another), @@ -1323,7 +1323,9 @@ If called from Lisp, return the number of words between START and END, without printing any message." (interactive (list nil nil)) (cond ((not (called-interactively-p 'any)) - (let ((words 0)) + (let ((words 0) + ;; Count across field boundaries. (Bug#41761) + (inhibit-field-text-motion t)) (save-excursion (save-restriction (narrow-to-region start end) @@ -1366,28 +1368,47 @@ END, without printing any message." (message "line %d (narrowed line %d)" (+ n (line-number-at-pos start) -1) n)))))) -(defun count-lines (start end) +(defun count-lines (start end &optional ignore-invisible-lines) "Return number of lines between START and END. -This is usually the number of newlines between them, -but can be one more if START is not equal to END -and the greater of them is not at the start of a line." +This is usually the number of newlines between them, but can be +one more if START is not equal to END and the greater of them is +not at the start of a line. + +When IGNORE-INVISIBLE-LINES is non-nil, invisible lines are not +included in the count." (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) - (if (eq selective-display t) - (save-match-data - (let ((done 0)) - (while (re-search-forward "[\n\C-m]" nil t 40) - (setq done (+ 40 done))) - (while (re-search-forward "[\n\C-m]" nil t 1) - (setq done (+ 1 done))) - (goto-char (point-max)) - (if (and (/= start end) - (not (bolp))) - (1+ done) - done))) - (- (buffer-size) (forward-line (buffer-size))))))) + (cond ((and (not ignore-invisible-lines) + (eq selective-display t)) + (save-match-data + (let ((done 0)) + (while (re-search-forward "\n\\|\r[^\n]" nil t 40) + (setq done (+ 40 done))) + (while (re-search-forward "\n\\|\r[^\n]" nil t 1) + (setq done (+ 1 done))) + (goto-char (point-max)) + (if (and (/= start end) + (not (bolp))) + (1+ done) + done)))) + (ignore-invisible-lines + (save-match-data + (- (buffer-size) + (forward-line (buffer-size)) + (let ((invisible-count 0) + prop) + (goto-char (point-min)) + (while (re-search-forward "\n\\|\r[^\n]" nil t) + (setq prop (get-char-property (1- (point)) 'invisible)) + (if (if (eq buffer-invisibility-spec t) + prop + (or (memq prop buffer-invisibility-spec) + (assq prop buffer-invisibility-spec))) + (setq invisible-count (1+ invisible-count)))) + invisible-count)))) + (t (- (buffer-size) (forward-line (buffer-size)))))))) (defun line-number-at-pos (&optional pos absolute) "Return buffer line number at position POS. @@ -1537,6 +1558,8 @@ in *Help* buffer. See also the command `describe-char'." ;; Might as well bind TAB to completion, since inserting a TAB char is ;; much too rarely useful. (define-key m "\t" 'completion-at-point) + (define-key m "\r" 'read--expression-try-read) + (define-key m "\n" 'read--expression-try-read) (set-keymap-parent m minibuffer-local-map) m)) @@ -1619,6 +1642,10 @@ display the result of expression evaluation." "Hook run by `eval-expression' when entering the minibuffer.") (defun read--expression (prompt &optional initial-contents) + "Read an Emacs Lisp expression from the minibuffer. + +PROMPT and optional argument INITIAL-CONTENTS do the same as in +function `read-from-minibuffer'." (let ((minibuffer-completing-symbol t)) (minibuffer-with-setup-hook (lambda () @@ -1634,6 +1661,45 @@ display the result of expression evaluation." read-expression-map t 'read-expression-history)))) +(defun read--expression-try-read () + "Try to read an Emacs Lisp expression in the minibuffer. + +Exit the minibuffer if successful, else report the error to the +user and move point to the location of the error. If point is +not already at the location of the error, push a mark before +moving point." + (interactive) + (unless (> (minibuffer-depth) 0) + (error "Minibuffer must be active")) + (if (let* ((contents (minibuffer-contents)) + (error-point nil)) + (with-temp-buffer + (condition-case err + (progn + (insert contents) + (goto-char (point-min)) + ;; `read' will signal errors like "End of file during + ;; parsing" and "Invalid read syntax". + (read (current-buffer)) + ;; Since `read' does not signal the "Trailing garbage + ;; following expression" error, we check for trailing + ;; garbage ourselves. + (or (progn + ;; This check is similar to what `string_to_object' + ;; does in minibuf.c. + (skip-chars-forward " \t\n") + (= (point) (point-max))) + (error "Trailing garbage following expression"))) + (error + (setq error-point (+ (length (minibuffer-prompt)) (point))) + (with-current-buffer (window-buffer (minibuffer-window)) + (unless (= (point) error-point) + (push-mark)) + (goto-char error-point) + (minibuffer-message (error-message-string err))) + nil)))) + (exit-minibuffer))) + (defun eval-expression-get-print-arguments (prefix-argument) "Get arguments for commands that print an expression result. Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT-LIMIT) @@ -1781,9 +1847,15 @@ to get different commands to edit and resubmit." (lambda () ;; Get a command name at point in the original buffer ;; to propose it after M-n. - (with-current-buffer (window-buffer (minibuffer-selected-window)) - (and (commandp (function-called-at-point)) - (format "%S" (function-called-at-point))))))) + (let ((def (with-current-buffer + (window-buffer (minibuffer-selected-window)) + (and (commandp (function-called-at-point)) + (format "%S" (function-called-at-point))))) + (all (sort (minibuffer-default-add-completions) + #'string<))) + (if def + (cons def (delete def all)) + all))))) ;; Read a string, completing from and restricting to the set of ;; all defined commands. Don't provide any initial input. ;; Save the command read on the extended-command history list. @@ -3369,6 +3441,14 @@ which is defined in the `warnings' library.\n") (setq buffer-undo-list nil) t)) +;;;; Shell commands + +(defconst shell-command-buffer-name "*Shell Command Output*" + "Name of the output buffer for shell commands.") + +(defconst shell-command-buffer-name-async "*Async Shell Command*" + "Name of the output buffer for asynchronous shell commands.") + (defvar shell-command-history nil "History list for some commands that read shell commands. @@ -3433,8 +3513,9 @@ to `shell-command-history'." (defcustom async-shell-command-buffer 'confirm-new-buffer "What to do when the output buffer is used by another shell command. This option specifies how to resolve the conflict where a new command -wants to direct its output to the buffer `*Async Shell Command*', -but this buffer is already taken by another running shell command. +wants to direct its output to the buffer whose name is stored +in `shell-command-buffer-name-async', but that buffer is already +taken by another running shell command. The value `confirm-kill-process' is used to ask for confirmation before killing the already running process and running a new process @@ -3585,14 +3666,18 @@ whose `car' is BUFFER." Like `shell-command', but adds `&' at the end of COMMAND to execute it asynchronously. -The output appears in the buffer `*Async Shell Command*'. -That buffer is in shell mode. +The output appears in the buffer whose name is stored in the +variable `shell-command-buffer-name-async'. That buffer is in +shell mode. You can configure `async-shell-command-buffer' to specify what to do -when the `*Async Shell Command*' buffer is already taken by another -running shell command. To run COMMAND without displaying the output -in a window you can configure `display-buffer-alist' to use the action -`display-buffer-no-window' for the buffer `*Async Shell Command*'. +when the buffer specified by `shell-command-buffer-name-async' is +already taken by another running shell command. + +To run COMMAND without displaying the output in a window you can +configure `display-buffer-alist' to use the action +`display-buffer-no-window' for the buffer given by +`shell-command-buffer-name-async'. In Elisp, you will often be better served by calling `start-process' directly, since it offers more control and does not impose the use of @@ -3628,16 +3713,18 @@ If `shell-command-prompt-show-cwd' is non-nil, show the current directory in the prompt. If COMMAND ends in `&', execute it asynchronously. -The output appears in the buffer `*Async Shell Command*'. -That buffer is in shell mode. You can also use -`async-shell-command' that automatically adds `&'. +The output appears in the buffer whose name is specified +by `shell-command-buffer-name-async'. That buffer is in shell +mode. You can also use `async-shell-command' that automatically +adds `&'. Otherwise, COMMAND is executed synchronously. The output appears in -the buffer `*Shell Command Output*'. If the output is short enough to -display in the echo area (which is determined by the variables -`resize-mini-windows' and `max-mini-window-height'), it is shown -there, but it is nonetheless available in buffer `*Shell Command -Output*' even though that buffer is not automatically displayed. +the buffer named by `shell-command-buffer-name'. If the output is +short enough to display in the echo area (which is determined by the +variables `resize-mini-windows' and `max-mini-window-height'), it is +shown there, but it is nonetheless available in buffer named by +`shell-command-buffer-name' even though that buffer is not +automatically displayed. To specify a coding system for converting non-ASCII characters in the shell command output, use \\[universal-coding-system-argument] \ @@ -3756,7 +3843,7 @@ impose the use of a shell (with its need to quote arguments)." (if (string-match "[ \t]*&[ \t]*\\'" command) ;; Command ending with ampersand means asynchronous. (let* ((buffer (get-buffer-create - (or output-buffer "*Async Shell Command*"))) + (or output-buffer shell-command-buffer-name-async))) (bname (buffer-name buffer)) (proc (get-buffer-process buffer)) (directory default-directory)) @@ -3908,9 +3995,9 @@ and are used only if a pop-up buffer is displayed." error-buffer display-error-buffer region-noncontiguous-p) "Execute string COMMAND in inferior shell with region as input. -Normally display output (if any) in temp buffer `*Shell Command Output*'; -Prefix arg means replace the region with it. Return the exit code of -COMMAND. +Normally display output (if any) in temp buffer specified +by `shell-command-buffer-name'; prefix arg means replace the region +with it. Return the exit code of COMMAND. To specify a coding system for converting non-ASCII characters in the input and output to the shell command, use \\[universal-coding-system-argument] @@ -3927,7 +4014,7 @@ in the echo area or in a buffer. If the output is short enough to display in the echo area \(determined by the variable `max-mini-window-height' if `resize-mini-windows' is non-nil), it is shown there. -Otherwise it is displayed in the buffer `*Shell Command Output*'. +Otherwise it is displayed in the buffer named by `shell-command-buffer-name'. The output is available in that buffer in both cases. If there is output and an error, a message about the error @@ -3937,7 +4024,7 @@ Optional fourth arg OUTPUT-BUFFER specifies where to put the command's output. If the value is a buffer or buffer name, erase that buffer and insert the output there; a non-nil value of `shell-command-dont-erase-buffer' prevent to erase the buffer. -If the value is nil, use the buffer `*Shell Command Output*'. +If the value is nil, use the buffer specified by `shell-command-buffer-name'. Any other non-nil value means to insert the output in the current buffer after START. @@ -4006,7 +4093,7 @@ characters." (funcall region-insert-function output)) (t (let ((buffer (get-buffer-create - (or output-buffer "*Shell Command Output*")))) + (or output-buffer shell-command-buffer-name)))) (with-current-buffer buffer (erase-buffer) (funcall region-insert-function output)) @@ -4025,7 +4112,7 @@ characters." (list t error-file) t))) ;; It is rude to delete a buffer that the command is not using. - ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) + ;; (let ((shell-buffer (get-buffer shell-command-buffer-name))) ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) ;; (kill-buffer shell-buffer))) ;; Don't muck with mark unless REPLACE says we should. @@ -4033,12 +4120,13 @@ characters." ;; No prefix argument: put the output in a temp buffer, ;; replacing its entire contents. (let ((buffer (get-buffer-create - (or output-buffer "*Shell Command Output*")))) + (or output-buffer shell-command-buffer-name)))) (set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111) (unwind-protect (if (and (eq buffer (current-buffer)) (or (memq shell-command-dont-erase-buffer '(nil erase)) - (and (not (eq buffer (get-buffer "*Shell Command Output*"))) + (and (not (eq buffer (get-buffer + shell-command-buffer-name))) (not (region-active-p))))) ;; If the input is the same buffer as the output, ;; delete everything but the specified region, diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 3609d6ba6a0..ea4e5dbc227 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -1,4 +1,4 @@ -;;; skeleton.el --- Lisp language extension for writing statement skeletons +;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1996, 2001-2020 Free Software Foundation, Inc. @@ -155,8 +155,7 @@ of `str' whereas the skeleton's interactor is then ignored." (prefix-numeric-value (or arg current-prefix-arg)) (and skeleton-autowrap - (or (eq last-command 'mouse-drag-region) - (and transient-mark-mode mark-active)) + (use-region-p) ;; Deactivate the mark, in case one of the ;; elements of the skeleton is sensitive ;; to such situations (e.g. it is itself a @@ -259,23 +258,25 @@ available: (goto-char (car skeleton-regions)) (setq skeleton-regions (cdr skeleton-regions))) (let ((beg (point)) - skeleton-modified skeleton-point resume: help input v1 v2) - (setq skeleton-positions nil) - (unwind-protect - (cl-progv - (mapcar #'car skeleton-further-elements) - (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements) - (skeleton-internal-list skeleton str)) - (or (eolp) (not skeleton-end-newline) (newline-and-indent)) - (run-hooks 'skeleton-end-hook) - (sit-for 0) - (or (not (eq (window-buffer) (current-buffer))) - (pos-visible-in-window-p beg) - (progn - (goto-char beg) - (recenter 0))) - (if skeleton-point - (goto-char skeleton-point)))))) + skeleton-modified skeleton-point) ;; resume: + (with-suppressed-warnings ((lexical help input v1 v2)) + (dlet (help input v1 v2) + (setq skeleton-positions nil) + (unwind-protect + (cl-progv + (mapcar #'car skeleton-further-elements) + (mapcar (lambda (x) (eval (cadr x) t)) skeleton-further-elements) + (skeleton-internal-list skeleton str)) + (or (eolp) (not skeleton-end-newline) (newline-and-indent)) + (run-hooks 'skeleton-end-hook) + (sit-for 0) + (or (not (eq (window-buffer) (current-buffer))) + (pos-visible-in-window-p beg) + (progn + (goto-char beg) + (recenter 0))) + (if skeleton-point + (goto-char skeleton-point)))))))) (defun skeleton-read (prompt &optional initial-input recursive) "Function for reading a string from the minibuffer within skeletons. @@ -328,36 +329,39 @@ automatically, and you are prompted to fill in the variable parts."))) (signal 'quit t) prompt)) -(defun skeleton-internal-list (skeleton-il &optional str recursive) +(defun skeleton-internal-list (skeleton &optional str recursive) (let* ((start (line-beginning-position)) (column (current-column)) (line (buffer-substring start (line-end-position))) - opoint) - (or str - (setq str `(setq str - (skeleton-read ',(car skeleton-il) nil ,recursive)))) - (when (and (eq (cadr skeleton-il) '\n) (not recursive) - (save-excursion (skip-chars-backward " \t") (bolp))) - (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) - (while (setq skeleton-modified (eq opoint (point)) - opoint (point) - skeleton-il (cdr skeleton-il)) - (condition-case quit - (skeleton-internal-1 (car skeleton-il) nil recursive) - (quit - (if (eq (cdr quit) 'recursive) - (setq recursive 'quit - skeleton-il (memq 'resume: skeleton-il)) - ;; Remove the subskeleton as far as it has been shown - ;; the subskeleton shouldn't have deleted outside current line. - (end-of-line) - (delete-region start (point)) - (insert line) - (move-to-column column) - (if (cdr quit) - (setq skeleton-il () - recursive nil) - (signal 'quit 'recursive))))))) + (skeleton-il skeleton) + opoint) + (with-suppressed-warnings ((lexical str)) + (dlet ((str (or str + `(setq str + (skeleton-read ',(car skeleton-il) + nil ,recursive))))) + (when (and (eq (cadr skeleton-il) '\n) (not recursive) + (save-excursion (skip-chars-backward " \t") (bolp))) + (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) + (while (setq skeleton-modified (eq opoint (point)) + opoint (point) + skeleton-il (cdr skeleton-il)) + (condition-case quit + (skeleton-internal-1 (car skeleton-il) nil recursive) + (quit + (if (eq (cdr quit) 'recursive) + (setq recursive 'quit + skeleton-il (memq 'resume: skeleton-il)) + ;; Remove the subskeleton as far as it has been shown + ;; the subskeleton shouldn't have deleted outside current line. + (end-of-line) + (delete-region start (point)) + (insert line) + (move-to-column column) + (if (cdr quit) + (setq skeleton-il () + recursive nil) + (signal 'quit 'recursive))))))))) ;; maybe continue loop or go on to next outer resume: section (if (eq recursive 'quit) (signal 'quit 'recursive) diff --git a/lisp/so-long.el b/lisp/so-long.el index f2c078ba841..f8a5cc920d9 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -255,8 +255,7 @@ ;; `so-long-mode', completely bypassing the automated decision process. ;; Refer to M-: (info "(emacs) Specifying File Variables") RET ;; -;; If so-long itself is causing problems, it can be inhibited by setting the -;; `so-long-enabled' variable to nil, or by disabling the global mode with +;; If so-long itself causes problems, disable the automated behaviour with ;; M-- M-x global-so-long-mode, or M-: (global-so-long-mode 0) ;; * Example configuration @@ -282,6 +281,43 @@ ;; '((show-trailing-whitespace . nil) ;; (truncate-lines . nil)))) +;; * Mode-specific configuration +;; ----------------------------- +;; The `so-long-predicate' function is called in the context of the buffer's +;; original major mode, and therefore major mode hooks can be used to control +;; the criteria for calling `so-long' in any given mode (plus its derivatives) +;; by setting buffer-local values for the variables in question. This includes +;; `so-long-predicate' itself, as well as any variables used by the predicate +;; when determining the result. By default this means `so-long-max-lines', +;; `so-long-skip-leading-comments', and `so-long-threshold'. E.g.: +;; +;; (add-hook 'js-mode-hook 'my-js-mode-hook) +;; +;; (defun my-js-mode-hook () +;; "Custom `js-mode' behaviours." +;; (setq-local so-long-max-lines 100) +;; (setq-local so-long-threshold 1000)) +;; +;; `so-long-variable-overrides' and `so-long-minor-modes' may also be given +;; buffer-local values in order to apply different settings to different types +;; of file. For example, the Bidirectional Parentheses Algorithm does not apply +;; to `<' and `>' characters by default, and therefore one might prefer to not +;; set `bidi-inhibit-bpa' in XML files, on the basis that XML files with long +;; lines are less likely to trigger BPA-related performance problems: +;; +;; (add-hook 'nxml-mode-hook 'my-nxml-mode-hook) +;; +;; (defun my-nxml-mode-hook () +;; "Custom `nxml-mode' behaviours." +;; (require 'so-long) +;; (setq-local so-long-variable-overrides +;; (remove '(bidi-inhibit-bpa . t) so-long-variable-overrides))) +;; +;; Finally, note that setting `so-long-target-modes' to nil buffer-locally in +;; a major mode hook would prevent that mode from ever being targeted. With +;; `prog-mode' being targeted by default, specific derivatives of `prog-mode' +;; could therefore be un-targeted if desired. + ;; * Other ways of using so-long ;; ----------------------------- ;; It may prove useful to automatically invoke major mode `so-long-mode' for @@ -376,7 +412,6 @@ ;; - Added mode-line indicator, user option `so-long-mode-line-label', ;; and faces `so-long-mode-line-active', `so-long-mode-line-inactive'. ;; - New help commands `so-long-commentary' and `so-long-customize'. -;; - Renamed `so-long-mode-enabled' to `so-long-enabled'. ;; - Refactored the default hook values using variable overrides ;; (and returning all the hooks to nil default values). ;; - Performance improvements for `so-long-detected-long-line-p'. @@ -416,9 +451,14 @@ (declare-function longlines-mode "longlines") (defvar longlines-mode) (defvar so-long-enabled nil - "Set to nil to prevent `so-long' from being triggered automatically. - -Has no effect if `global-so-long-mode' is not enabled.") + ;; This was initially a renaming of the old `so-long-mode-enabled' and + ;; documented as "Set to nil to prevent `so-long' from being triggered + ;; automatically."; however `so-long--ensure-enabled' may forcibly re-enable + ;; it contrary to the user's expectations, so for the present this should be + ;; considered internal-use only (with `global-so-long-mode' the interface + ;; for enabling or disabling the automated behaviour). FIXME: Establish a + ;; way to support the original use-case, or rename to `so-long--enabled'. + "Internal use. Non-nil when any so-long functionality has been used.") (defvar-local so-long--active nil ; internal use "Non-nil when `so-long' mitigations are in effect.") @@ -886,9 +926,15 @@ buffer-local." Stores the existing value for each entry in `so-long-variable-overrides'. Stores the name of each enabled mode from the list `so-long-minor-modes'. +The lists themselves are also remembered, so that major mode hooks can +provide buffer-local modifications which are still accessible after changing +to `so-long-mode'. + If RESET is non-nil, remove any existing values before storing the new ones." (when reset (setq so-long-original-values nil)) + (so-long-remember 'so-long-variable-overrides) + (so-long-remember 'so-long-minor-modes) (dolist (ovar so-long-variable-overrides) (so-long-remember (car ovar))) (dolist (mode so-long-minor-modes) @@ -1288,7 +1334,7 @@ Calls `so-long-disable-minor-modes' and `so-long-override-variables'." (defun so-long-disable-minor-modes () "Disable any active minor modes listed in `so-long-minor-modes'." - (dolist (mode so-long-minor-modes) + (dolist (mode (so-long-original 'so-long-minor-modes)) (when (and (boundp mode) mode) (funcall mode 0)))) @@ -1304,7 +1350,7 @@ The modes are enabled in accordance with what was remembered in `so-long'." (defun so-long-override-variables () "Set the buffer-local values defined by `so-long-variable-overrides'." - (dolist (ovar so-long-variable-overrides) + (dolist (ovar (so-long-original 'so-long-variable-overrides)) (set (make-local-variable (car ovar)) (cdr ovar)))) (defun so-long-restore-variables () @@ -1879,7 +1925,7 @@ If it appears in `%s', you should remove it." ; LocalWords: defadvice nadvice whitespace ie bos eos eobp origmode un Un setq ; LocalWords: docstring auf Wiedersehen longlines alist autoload Refactored Inc ; LocalWords: MERCHANTABILITY RET REGEXP VAR ELPA WS mitigations EmacsWiki eval -; LocalWords: rx filename filenames bidi bpa +; LocalWords: rx filename filenames js defun bidi bpa prog FIXME ;; So long, farewell, auf Wiedersehen, goodbye ;; You have to go, this code is minified diff --git a/lisp/speedbar.el b/lisp/speedbar.el index e9c15b71ce6..5b98eb36bb9 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -3240,19 +3240,21 @@ With universal argument ARG, flush cached data." "Expand the line under the cursor and all descendants. Optional argument ARG indicates that any cache should be flushed." (interactive "P") - (speedbar-expand-line arg) - ;; Now, inside the area expanded here, expand all subnodes of - ;; the same descendant type. - (save-excursion - (speedbar-next 1) ;; Move into the list. - (let ((err nil)) - (while (not err) - (condition-case nil - (progn - (speedbar-expand-line-descendants arg) - (speedbar-restricted-next 1)) - (error (setq err t)))))) - ) + (save-restriction + (narrow-to-region (line-beginning-position) + (line-beginning-position 2)) + (speedbar-expand-line arg) + ;; Now, inside the area expanded here, expand all subnodes of + ;; the same descendant type. + (save-excursion + (speedbar-next 1) ;; Move into the list. + (let ((err nil)) + (while (not err) + (condition-case nil + (progn + (speedbar-expand-line-descendants arg) + (speedbar-restricted-next 1)) + (error (setq err t)))))))) (defun speedbar-contract-line-descendants () "Expand the line under the cursor and all descendants." diff --git a/lisp/startup.el b/lisp/startup.el index 238718670bd..2d938b8889d 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -649,11 +649,12 @@ It is the default value of the variable `top-level'." ;; Use FOO/., so that if FOO is a symlink, file-attributes ;; describes the directory linked to, not FOO itself. (or (and default-directory - (equal (file-attributes - (concat (file-name-as-directory pwd) ".")) - (file-attributes - (concat (file-name-as-directory default-directory) - ".")))) + (ignore-errors + (equal (file-attributes + (concat (file-name-as-directory pwd) ".")) + (file-attributes + (concat (file-name-as-directory default-directory) + "."))))) (setq process-environment (delete (concat "PWD=" pwd) process-environment))))) diff --git a/lisp/subr.el b/lisp/subr.el index 6bd06a0b82c..0bd09c6556d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1583,11 +1583,6 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") (make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1") -(defun forward-point (n) - "Return buffer position N characters after (before if N negative) point." - (declare (obsolete "use (+ (point) N) instead." "23.1")) - (+ (point) n)) - (defun log10 (x) "Return (log X 10), the log base 10 of X." (declare (obsolete log "24.4")) @@ -1612,8 +1607,6 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") (make-obsolete 'run-window-configuration-change-hook nil "27.1") -(make-obsolete 'process-filter-multibyte-p nil "23.1") -(make-obsolete 'set-process-filter-multibyte nil "23.1") (make-obsolete-variable 'command-debug-status "expect it to be removed in a future version." "25.2") @@ -1656,7 +1649,8 @@ be a list of the form returned by `event-start' and `event-end'." (defalias 'point-at-eol 'line-end-position) (defalias 'point-at-bol 'line-beginning-position) -(defalias 'user-original-login-name 'user-login-name) +(define-obsolete-function-alias 'user-original-login-name + 'user-login-name "28.1") ;;;; Hook manipulation functions. diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index a1af53d8c46..4feab71401e 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el @@ -63,8 +63,6 @@ (set-terminal-parameter nil 'gpm-mouse-active nil)) ;;;###autoload -(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") -;;;###autoload (define-minor-mode gpm-mouse-mode "Toggle mouse support in GNU/Linux consoles (GPM Mouse mode). diff --git a/lisp/term.el b/lisp/term.el index b990c83cfcb..99f1bf4f54f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -467,6 +467,11 @@ Customize this option to nil if you want the previous behavior." :type 'boolean :group 'term) +(defcustom term-set-terminal-size nil + "If non-nil, set the LINES and COLUMNS environment variables." + :type 'boolean + :version "28.1") + (defcustom term-char-mode-point-at-process-mark t "If non-nil, keep point at the process mark in char mode. @@ -501,6 +506,14 @@ This variable is buffer-local." :type 'boolean :group 'term) +(defcustom term-scroll-snap-to-bottom t + "Control whether to keep the prompt at the bottom of the window. +If non-nil, when the prompt is visible within the window, then +scroll so that the prompt is on the bottom on any input or +output." + :version "28.1" + :type 'boolean) + (defcustom term-scroll-show-maximum-output nil "Controls how interpreter output causes window to scroll. If non-nil, then show the maximum output when the window is scrolled. @@ -1543,9 +1556,12 @@ Nil if unknown.") (format term-termcap-format "TERMCAP=" term-term-name term-height term-width) - (format "INSIDE_EMACS=%s,term:%s" emacs-version term-protocol-version) - (format "LINES=%d" term-height) - (format "COLUMNS=%d" term-width)) + (format "INSIDE_EMACS=%s,term:%s" + emacs-version term-protocol-version)) + (when term-set-terminal-size + (list + (format "LINES=%d" term-height) + (format "COLUMNS=%d" term-width))) process-environment)) (process-connection-type t) ;; We should suppress conversion of end-of-line format. @@ -3108,15 +3124,19 @@ See `term-prompt-regexp'." (or (eq scroll 'this) (not save-point))) (and (eq scroll 'others) (not (eq selected win)))) - (goto-char term-home-marker) - (recenter 0) + (when term-scroll-snap-to-bottom + (goto-char term-home-marker) + (recenter 0)) (goto-char (process-mark proc)) (if (not (pos-visible-in-window-p (point) win)) (recenter -1))) ;; Optionally scroll so that the text ;; ends at the bottom of the window. (when (and term-scroll-show-maximum-output - (>= (point) (process-mark proc))) + (>= (point) (process-mark proc)) + (or term-scroll-snap-to-bottom + (not (pos-visible-in-window-p + (point-max) win)))) (save-excursion (goto-char (point-max)) (recenter -1))))) diff --git a/lisp/term/st.el b/lisp/term/st.el new file mode 100644 index 00000000000..617664bb263 --- /dev/null +++ b/lisp/term/st.el @@ -0,0 +1,20 @@ +;;; st.el --- terminal initialization for st -*- lexical-binding:t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;;; Commentary: + +;; Support for the st terminal emulator. +;; https://st.suckless.org/ + +;;; Code: + +(require 'term/xterm) + +(defun terminal-init-st () + "Terminal initialization function for st." + (tty-run-terminal-initialization (selected-frame) "xterm")) + +(provide 'term/st) + +;; st.el ends here diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 5901e0295e1..e866fdc36ce 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -78,12 +78,8 @@ (require 'dnd) (require 'w32-vars) -;; Keep an obsolete alias for w32-focus-frame and w32-select-font in case -;; they are used by code outside Emacs. -(define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1") (declare-function x-select-font "w32font.c" (&optional frame exclude-proportional)) -(define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1") (defvar w32-color-map) ;; defined in w32fns.c (make-obsolete 'w32-default-color-map nil "24.1") diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 0018b89d858..910bd7dbb9d 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -3445,6 +3445,7 @@ if that value is non-nil. (set (make-local-variable 'syntax-propertize-function) (syntax-propertize-via-font-lock bibtex-font-lock-syntactic-keywords)) + (bibtex-set-dialect nil t) ;; Allow `bibtex-dialect' as a file-local variable. (add-hook 'hack-local-variables-hook #'bibtex-set-dialect nil t)) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 39a1b488a74..23f96d7e0ee 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -57,7 +57,6 @@ (defcustom flyspell-highlight-flag t "How Flyspell should indicate misspelled words. Non-nil means use highlight, nil means use minibuffer messages." - :group 'flyspell :type 'boolean) (defcustom flyspell-mark-duplications-flag t @@ -65,12 +64,10 @@ Non-nil means use highlight, nil means use minibuffer messages." See `flyspell-mark-duplications-exceptions' to add exceptions to this rule. Detection of repeated words is not implemented in \"large\" regions; see variable `flyspell-large-region'." - :group 'flyspell :type 'boolean) (defcustom flyspell-case-fold-duplications t "Non-nil means Flyspell matches duplicate words case-insensitively." - :group 'flyspell :type 'boolean :version "27.1") @@ -87,7 +84,6 @@ dictionary name (`ispell-local-dictionary' or EXCEPTION-LIST is a list of strings. The checked word is downcased before comparing with these exceptions." - :group 'flyspell :type '(alist :key-type (choice (const :tag "All dictionaries" nil) regexp) :value-type (repeat string)) @@ -97,7 +93,6 @@ downcased before comparing with these exceptions." "If non-nil, sort the corrections before popping them. The sorting is controlled by the `flyspell-sort-corrections-function' variable, and defaults to sorting alphabetically." - :group 'flyspell :version "21.1" :type 'boolean) @@ -109,8 +104,7 @@ function takes three parameters -- the two correction candidates to be sorted, and the third parameter is the word that's being corrected." :version "26.1" - :type 'function - :group 'flyspell) + :type 'function) (defun flyspell-sort-corrections-alphabetically (corr1 corr2 _) (string< corr1 corr2)) @@ -130,14 +124,12 @@ Flyspell uses a different face (`flyspell-duplicate') to highlight it. This variable specifies how far to search to find such a duplicate. -1 means no limit (search the whole buffer). 0 means do not search for duplicate unrecognized spellings." - :group 'flyspell :version "24.5" ; -1 -> 400000 :type '(choice (const :tag "no limit" -1) number)) (defcustom flyspell-delay 3 "The number of seconds to wait before checking, after a \"delayed\" command." - :group 'flyspell :type 'number) (defcustom flyspell-persistent-highlight t @@ -147,12 +139,10 @@ is highlighted, and the highlight is turned off as soon as point moves off the misspelled word. Make sure this variable is non-nil if you use `flyspell-region'." - :group 'flyspell :type 'boolean) (defcustom flyspell-highlight-properties t "Non-nil means highlight incorrect words even if a property exists for this word." - :group 'flyspell :type 'boolean) (defcustom flyspell-default-delayed-commands @@ -164,7 +154,6 @@ Make sure this variable is non-nil if you use `flyspell-region'." backward-delete-char-untabify) "The standard list of delayed commands for Flyspell. See `flyspell-delayed-commands'." - :group 'flyspell :version "21.1" :type '(repeat (symbol))) @@ -172,7 +161,6 @@ See `flyspell-delayed-commands'." "List of commands that are \"delayed\" for Flyspell mode. After these commands, Flyspell checking is delayed for a short time, whose length is specified by `flyspell-delay'." - :group 'flyspell :type '(repeat (symbol))) (defcustom flyspell-default-deplacement-commands @@ -182,7 +170,6 @@ whose length is specified by `flyspell-delay'." scroll-down) "The standard list of deplacement commands for Flyspell. See variable `flyspell-deplacement-commands'." - :group 'flyspell :version "21.1" :type '(repeat (symbol))) @@ -190,18 +177,15 @@ See variable `flyspell-deplacement-commands'." "List of commands that are \"deplacement\" for Flyspell mode. After these commands, Flyspell checking is performed only if the previous command was not the very same command." - :group 'flyspell :version "21.1" :type '(repeat (symbol))) (defcustom flyspell-issue-welcome-flag t "Non-nil means that Flyspell should display a welcome message when started." - :group 'flyspell :type 'boolean) (defcustom flyspell-issue-message-flag t "Non-nil means that Flyspell emits messages when checking words." - :group 'flyspell :type 'boolean) (defcustom flyspell-incorrect-hook nil @@ -213,7 +197,6 @@ of possible corrections as returned by `ispell-parse-output'. If any of the functions return non-nil, the word is not highlighted as incorrect." - :group 'flyspell :version "21.1" :type 'hook) @@ -225,14 +208,12 @@ when flyspell is started, the value of that variable is used instead of `flyspell-default-dictionary' to select the default dictionary. Otherwise, if `flyspell-default-dictionary' is nil, it means to use Ispell's ultimate default dictionary." - :group 'flyspell :version "21.1" :type '(choice string (const :tag "Default" nil))) (defcustom flyspell-tex-command-regexp "\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)" "A string that is the regular expression that matches TeX commands." - :group 'flyspell :version "21.1" :type 'regexp) @@ -241,34 +222,29 @@ Ispell's ultimate default dictionary." TeX math environments are discovered by `texmathp', implemented inside AUCTeX package. That package may be found at URL `https://www.gnu.org/software/auctex/'" - :group 'flyspell :type 'boolean) (defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter '("francais" "deutsch8" "norsk") "List of dictionary names that consider `-' as word delimiter." - :group 'flyspell :version "21.1" :type '(repeat (string))) (defcustom flyspell-abbrev-p nil "If non-nil, add correction to abbreviation table." - :group 'flyspell :version "21.1" :type 'boolean) (defcustom flyspell-use-global-abbrev-table-p nil "If non-nil, prefer global abbrev table to local abbrev table." - :group 'flyspell :version "21.1" :type 'boolean) (defcustom flyspell-mode-line-string " Fly" "String displayed on the mode line when flyspell is active. Set this to nil if you don't want a mode line indicator." - :group 'flyspell :type '(choice string (const :tag "None" nil))) (defcustom flyspell-large-region 1000 @@ -282,30 +258,25 @@ Doubled words are not detected in a large region, because Ispell does not check for them. If this variable is nil, all regions are treated as small." - :group 'flyspell :version "21.1" :type '(choice number (const :tag "All small" nil))) (defcustom flyspell-insert-function (function insert) "Function for inserting word by flyspell upon correction." - :group 'flyspell :type 'function) (defcustom flyspell-before-incorrect-word-string nil "String used to indicate an incorrect word starting." - :group 'flyspell :type '(choice string (const nil))) (defcustom flyspell-after-incorrect-word-string nil "String used to indicate an incorrect word ending." - :group 'flyspell :type '(choice string (const nil))) (defvar flyspell-mode-map) (defcustom flyspell-use-meta-tab t "Non-nil means that flyspell uses M-TAB to correct word." - :group 'flyspell :type 'boolean :initialize 'custom-initialize-default :set (lambda (sym val) @@ -316,8 +287,7 @@ If this variable is nil, all regions are treated as small." (defcustom flyspell-auto-correct-binding [(control ?\;)] "The key binding for flyspell auto correction." - :type 'key-sequence - :group 'flyspell) + :type 'key-sequence) ;;*---------------------------------------------------------------------*/ ;;* Mode specific options */ @@ -475,6 +445,22 @@ like <img alt=\"Some thing.\">." map) "Minor mode keymap for Flyspell mode--for the whole buffer.") +;; correct on mouse 3 +(defun flyspell--set-use-mouse-3-for-menu (var value) + (set-default var value) + (if value + (progn (define-key flyspell-mouse-map [mouse-2] nil) + (define-key flyspell-mouse-map [down-mouse-3] 'flyspell-correct-word)) + (define-key flyspell-mouse-map [mouse-2] 'flyspell-correct-word) + (define-key flyspell-mouse-map [down-mouse-3] nil))) + +(defcustom flyspell-use-mouse-3-for-menu nil + "Non-nil means to bind `mouse-3' to `flyspell-correct-word'. +If this is set, also unbind `mouse-2'." + :type 'boolean + :set 'flyspell--set-use-mouse-3-for-menu + :version "28.1") + ;; dash character machinery (defvar flyspell-consider-dash-as-word-delimiter-flag nil "Non-nil means that the `-' char is considered as a word delimiter.") @@ -493,8 +479,7 @@ like <img alt=\"Some thing.\">." (t :underline t :inherit error)) "Flyspell face for misspelled words." - :version "24.4" - :group 'flyspell) + :version "24.4") (defface flyspell-duplicate '((((supports :underline (:style wave))) @@ -503,8 +488,7 @@ like <img alt=\"Some thing.\">." :underline t :inherit warning)) "Flyspell face for words that appear twice in a row. See also `flyspell-duplicate-distance'." - :version "24.4" - :group 'flyspell) + :version "24.4") (defvar flyspell-overlay nil) @@ -546,7 +530,10 @@ in your init file. :group 'flyspell (if flyspell-mode (condition-case err - (flyspell-mode-on) + (progn + (when flyspell-use-mouse-3-for-menu + (flyspell--set-use-mouse-3-for-menu 'flyspell-use-mouse-3-for-menu t)) + (flyspell-mode-on)) (error (message "Error enabling Flyspell mode:\n%s" (cdr err)) (flyspell-mode -1))) (flyspell-mode-off))) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 65f61644b6d..b2ccbc8da24 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -621,15 +621,6 @@ For Aspell, non-nil also means to try to automatically find its dictionaries. Earlier Aspell versions do not consistently support charset encoding. Handling this would require some extra guessing in `ispell-aspell-find-dictionary'.") -(defvar ispell-aspell-supports-utf8 nil - "Non-nil if Aspell has consistent command line UTF-8 support. Obsolete. -ispell.el and flyspell.el will use for this purpose the more generic -variable `ispell-encoding8-command' for both Aspell and Hunspell. Is left -here just for backwards compatibility.") - -(make-obsolete-variable 'ispell-aspell-supports-utf8 - 'ispell-encoding8-command "23.1") - (defvar ispell-dicts-name2locale-equivs-alist '(("american" "en_US") ("brasileiro" "pt_BR") @@ -682,9 +673,7 @@ Otherwise returns the library directory name, if that is defined." ;; all versions, since versions earlier than 3.0.09 didn't identify ;; themselves on startup. (interactive "p") - (let ((default-directory (or (and (boundp 'temporary-file-directory) - temporary-file-directory) - default-directory)) + (let ((default-directory (or temporary-file-directory default-directory)) (get-config-var (lambda (var) (when (re-search-forward @@ -3734,8 +3723,7 @@ looking for a dictionary, please see the distribution of the GNU ispell program, or do an Internet search; there are various dictionaries available on the net." (interactive) - (if (and (boundp 'transient-mark-mode) transient-mark-mode - (boundp 'mark-active) mark-active) + (if (and transient-mark-mode mark-active) (ispell-region (region-beginning) (region-end)) (ispell-buffer))) diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index e22e3f48994..b0975291428 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -371,33 +371,50 @@ See `forward-paragraph' for more information." (defun mark-paragraph (&optional arg allow-extend) "Put point at beginning of this paragraph, mark at end. -The paragraph marked is the one that contains point or follows point. +The paragraph marked is the one that contains point or follows +point. -With argument ARG, puts mark at end of a following paragraph, so that -the number of paragraphs marked equals ARG. +With argument ARG, puts mark at the end of this or a following +paragraph, so that the number of paragraphs marked equals ARG. -If ARG is negative, point is put at end of this paragraph, mark is put -at beginning of this or a previous paragraph. +If ARG is negative, point is put at the end of this paragraph, +mark is put at the beginning of this or a previous paragraph. Interactively (or if ALLOW-EXTEND is non-nil), if this command is -repeated or (in Transient Mark mode) if the mark is active, -it marks the next ARG paragraphs after the ones already marked." - (interactive "p\np") - (unless arg (setq arg 1)) - (when (zerop arg) - (error "Cannot mark zero paragraphs")) - (cond ((and allow-extend - (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active))) - (set-mark - (save-excursion - (goto-char (mark)) - (forward-paragraph arg) - (point)))) - (t - (forward-paragraph arg) - (push-mark nil t t) - (backward-paragraph arg)))) +repeated or (in Transient Mark mode) if the mark is active, it +marks the next ARG paragraphs after the region already marked. +This also means when activating the mark immediately before using +this command, the current paragraph is only marked from point." + (interactive "P\np") + (let ((numeric-arg (prefix-numeric-value arg))) + (cond ((zerop numeric-arg)) + ((and allow-extend + (or (and (eq last-command this-command) mark-active) + (region-active-p))) + (if arg + (setq arg numeric-arg) + (if (< (mark) (point)) + (setq arg -1) + (setq arg 1))) + (set-mark + (save-excursion + (goto-char (mark)) + (forward-paragraph arg) + (point)))) + ;; don't activate the mark when at eob + ((and (eobp) (> numeric-arg 0))) + (t + (unless (save-excursion + (forward-line 0) + (looking-at paragraph-start)) + (backward-paragraph (cond ((> numeric-arg 0) 1) + ((< numeric-arg 0) -1) + (t 0)))) + (push-mark + (save-excursion + (forward-paragraph numeric-arg) + (point)) + t t))))) (defun kill-paragraph (arg) "Kill forward to end of paragraph. diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 279dbb4450c..7bc7dc1762e 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -487,9 +487,6 @@ Most useful for remembering things from other applications." (interactive) (remember-region (point-min) (point-max))) -;; Org needs this -(define-obsolete-function-alias 'remember-buffer 'remember-finalize "23.1") - (defun remember-destroy () "Destroy the current *Remember* buffer." (interactive) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index e3d5759579a..a905d148009 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -593,7 +593,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; Miscellany. (slash "\\\\") (opt " *\\(\\[[^]]*\\] *\\)*") - (args "\\(\\(?:[^{}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)") + (args "\\(\\(?:[^${}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)") (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")) (list ;; diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 66378cb3468..b3bc634de9b 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -482,6 +482,13 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") (define-key map "\C-c\C-ce" 'texinfo-insert-@end) (define-key map "\C-c\C-cd" 'texinfo-insert-@dfn) (define-key map "\C-c\C-cc" 'texinfo-insert-@code) + + ;; bindings for environment movement + (define-key map "\C-c." 'texinfo-to-environment-bounds) + (define-key map "\C-c\C-c\C-f" 'texinfo-next-environment-end) + (define-key map "\C-c\C-c\C-b" 'texinfo-previous-environment-end) + (define-key map "\C-c\C-c\C-n" 'texinfo-next-environment-start) + (define-key map "\C-c\C-c\C-p" 'texinfo-previous-environment-start) map)) (easy-menu-define texinfo-mode-menu @@ -1072,6 +1079,70 @@ You are prompted for the job number (use a number shown by a previous ;; job-number"\n")) (tex-recenter-output-buffer nil)) +(defun texinfo-to-environment-bounds () + "Move point alternately to the start and end of a Texinfo environment. +Do nothing when outside of an environment. This command does not +handle nested environments." + (interactive) + (cond ((save-excursion + (forward-line 0) + (looking-at texinfo-environment-regexp)) + (if (save-excursion + (forward-line 0) + (looking-at "^@end")) + (texinfo-previous-environment-start) + (texinfo-next-environment-end))) + ((save-excursion + (and (re-search-backward texinfo-environment-regexp nil t) + (not (looking-at "^@end")))) + (texinfo-previous-environment-start)) + ;; Otherwise, point is outside of an environment, so do nothing. + )) + +(defun texinfo-next-environment-start () + "Move forward to the beginning of a Texinfo environment." + (interactive) + (if (looking-at texinfo-environment-regexp) + (forward-line 1)) + (while (and (re-search-forward texinfo-environment-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (looking-at "@end")))) + (if (save-excursion + (forward-line 0) + (looking-at texinfo-environment-regexp)) + (forward-line 0))) + +(defun texinfo-previous-environment-start () + "Move back to the beginning of the previous Texinfo environment." + (interactive) + (while (and (re-search-backward texinfo-environment-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (looking-at "@end"))))) + +(defun texinfo-next-environment-end () + "Move forward to the beginning of the next @end line of an environment." + (interactive) + (if (looking-at "^@end") + (forward-line 1)) + (while (and (re-search-forward texinfo-environment-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (not (looking-at "^@end"))))) + (if (save-excursion + (forward-line 0) + (looking-at "^@end")) + (forward-line 0))) + +(defun texinfo-previous-environment-end () + "Move backward to the beginning of the next @end line of an environment." + (interactive) + (while (and (re-search-backward texinfo-environment-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (not (looking-at "@end")))))) + (provide 'texinfo) ;;; texinfo.el ends here diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 1a15df33e50..3c2d766ffb1 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -258,7 +258,7 @@ E.g.: ;; Filenames -(defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:" +(defvar thing-at-point-file-name-chars "-@~/[:alnum:]_.${}#%,:" "Characters allowable in filenames.") (define-thing-chars filename thing-at-point-file-name-chars) @@ -334,7 +334,7 @@ the bounds of a possible ill-formed URI (one lacking a scheme)." ;; may contain parentheses but may not contain spaces (RFC3986). (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'") (skip-before "^[0-9a-zA-Z]") - (skip-after ":;.,!?") + (skip-after ":;.,!?'") (pt (point)) (beg (save-excursion (skip-chars-backward allowed-chars) diff --git a/lisp/time.el b/lisp/time.el index 44fd1a7e337..1ab992adb45 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -25,8 +25,7 @@ ;; Facilities to display current time/date and a new-mail indicator ;; in the Emacs mode line. The entry point is `display-time'. -;; Display time world in a buffer, the entry point is -;; `display-time-world'. +;; Use `world-clock' to display world clock in a buffer. ;;; Code: @@ -35,23 +34,20 @@ :group 'mode-line :group 'mail) - (defcustom display-time-mail-file nil "File name of mail inbox file, for indicating existence of new mail. Non-nil and not a string means don't check for mail; nil means use default, which is system-dependent, and is the same as used by Rmail." :type '(choice (const :tag "None" none) (const :tag "Default" nil) - (file :format "%v")) - :group 'display-time) + (file :format "%v"))) (defcustom display-time-mail-directory nil "Name of mail inbox directory, for indicating existence of new mail. Any nonempty regular file in the directory is regarded as newly arrived mail. If nil, do not check a directory for arriving mail." :type '(choice (const :tag "None" nil) - (directory :format "%v")) - :group 'display-time) + (directory :format "%v"))) (defcustom display-time-mail-function nil "Function to call, for indicating existence of new mail. @@ -59,8 +55,7 @@ If nil, that means use the default method: check that the file specified by `display-time-mail-file' is nonempty or that the directory `display-time-mail-directory' contains nonempty files." :type '(choice (const :tag "Default" nil) - (function)) - :group 'display-time) + (function))) (defcustom display-time-default-load-average 0 "Which load average value will be shown in the mode line. @@ -75,8 +70,7 @@ The value can be one of: :type '(choice (const :tag "1 minute load" 0) (const :tag "5 minutes load" 1) (const :tag "15 minutes load" 2) - (const :tag "None" nil)) - :group 'display-time) + (const :tag "None" nil))) (defvar display-time-load-average nil "Value of the system's load average currently shown on the mode line. @@ -86,27 +80,23 @@ This is an internal variable; setting it has no effect.") (defcustom display-time-load-average-threshold 0.1 "Load-average values below this value won't be shown in the mode line." - :type 'number - :group 'display-time) + :type 'number) ;;;###autoload (defcustom display-time-day-and-date nil "\ Non-nil means \\[display-time] should display day and date as well as time." - :type 'boolean - :group 'display-time) + :type 'boolean) (defvar display-time-timer nil) (defcustom display-time-interval 60 "Seconds between updates of time in the mode line." - :type 'integer - :group 'display-time) + :type 'integer) (defcustom display-time-24hr-format nil "Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23. A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used." - :type 'boolean - :group 'display-time) + :type 'boolean) (defvar display-time-string nil "String used in mode lines to display a time string. @@ -116,103 +106,12 @@ It should not be set directly, but is instead updated by the (defcustom display-time-hook nil "List of functions to be called when the time is updated on the mode line." - :type 'hook - :group 'display-time) + :type 'hook) (defvar display-time-server-down-time nil "Time when mail file's file system was recorded to be down. If that file system seems to be up, the value is nil.") -(defcustom zoneinfo-style-world-list - '(("America/Los_Angeles" "Seattle") - ("America/New_York" "New York") - ("Europe/London" "London") - ("Europe/Paris" "Paris") - ("Asia/Calcutta" "Bangalore") - ("Asia/Tokyo" "Tokyo")) - "Alist of zoneinfo-style time zones and places for `display-time-world'. -Each element has the form (TIMEZONE LABEL). -TIMEZONE should be a string of the form AREA/LOCATION, where AREA is -the name of a region -- a continent or ocean, and LOCATION is the name -of a specific location, e.g., a city, within that region. -LABEL is a string to display as the label of that TIMEZONE's time." - :group 'display-time - :type '(repeat (list string string)) - :version "23.1") - -(defcustom legacy-style-world-list - '(("PST8PDT" "Seattle") - ("EST5EDT" "New York") - ("GMT0BST" "London") - ("CET-1CDT" "Paris") - ("IST-5:30" "Bangalore") - ("JST-9" "Tokyo")) - "Alist of traditional-style time zones and places for `display-time-world'. -Each element has the form (TIMEZONE LABEL). -TIMEZONE should be a string of the form: - - std[+|-]offset[dst[offset][,date[/time],date[/time]]] - -See the documentation of the TZ environment variable on your system, -for more details about the format of TIMEZONE. -LABEL is a string to display as the label of that TIMEZONE's time." - :group 'display-time - :type '(repeat (list string string)) - :version "23.1") - -(defcustom display-time-world-list t - "Alist of time zones and places for `display-time-world' to display. -Each element has the form (TIMEZONE LABEL). -TIMEZONE should be in a format supported by your system. See the -documentation of `zoneinfo-style-world-list' and -`legacy-style-world-list' for two widely used formats. LABEL is -a string to display as the label of that TIMEZONE's time. - -If the value is t instead of an alist, use the value of -`zoneinfo-style-world-list' if it works on this platform, and of -`legacy-style-world-list' otherwise." - - :group 'display-time - :type '(choice (const :tag "Default" t) - (repeat :tag "List of zones and labels" - (list (string :tag "Zone") (string :tag "Label")))) - :version "23.1") - -(defun time--display-world-list () - (if (listp display-time-world-list) - display-time-world-list - ;; Determine if zoneinfo style timezones are supported by testing that - ;; America/New York and Europe/London return different timezones. - (let ((nyt (format-time-string "%z" nil "America/New_York")) - (gmt (format-time-string "%z" nil "Europe/London"))) - (if (string-equal nyt gmt) - legacy-style-world-list - zoneinfo-style-world-list)))) - -(defcustom display-time-world-time-format "%A %d %B %R %Z" - "Format of the time displayed, see `format-time-string'." - :group 'display-time - :type 'string - :version "23.1") - -(defcustom display-time-world-buffer-name "*wclock*" - "Name of the world clock buffer." - :group 'display-time - :type 'string - :version "23.1") - -(defcustom display-time-world-timer-enable t - "If non-nil, a timer will update the world clock." - :group 'display-time - :type 'boolean - :version "23.1") - -(defcustom display-time-world-timer-second 60 - "Interval in seconds for updating the world clock." - :group 'display-time - :type 'integer - :version "23.1") - ;;;###autoload (defun display-time () "Enable display of time, load level, and mail flag in mode lines. @@ -249,14 +148,12 @@ See `display-time-use-mail-icon' and `display-time-mail-face'.") "Non-nil means use an icon as mail indicator on a graphic display. Otherwise use `display-time-mail-string'. The icon may consume less of the mode line. It is specified by `display-time-mail-icon'." - :group 'display-time :type 'boolean) ;; Fixme: maybe default to the character if we can display Unicode. (defcustom display-time-mail-string "Mail" "String to use as the mail indicator in `display-time-string-forms'. This can use the Unicode letter character if you can display it." - :group 'display-time :version "22.1" :type '(choice (const "Mail") ;; Use :tag here because the Lucid menu won't display @@ -270,8 +167,7 @@ See the function `format-time-string' for an explanation of how to write this string. If this is nil, the defaults depend on `display-time-day-and-date' and `display-time-24hr-format'." :type '(choice (const :tag "Default" nil) - string) - :group 'display-time) + string)) (defcustom display-time-string-forms '((if (and (not display-time-format) display-time-day-and-date) @@ -325,8 +221,7 @@ For example: (if mail \" Mail\" \"\")) would give mode line times like `94/12/30 21:07:48 (UTC)'." - :type '(repeat sexp) - :group 'display-time) + :type '(repeat sexp)) (defun display-time-event-handler () (display-time-update) @@ -508,13 +403,127 @@ runs the normal hook `display-time-hook' after each update." (remove-hook 'rmail-after-get-new-mail-hook 'display-time-event-handler))) + +;;; Obsolete names + +(define-obsolete-variable-alias 'display-time-world-list + 'world-clock-list "28.1") +(define-obsolete-variable-alias 'display-time-world-time-format + 'world-clock-time-format "28.1") +(define-obsolete-variable-alias 'display-time-world-buffer-name + 'world-clock-buffer-name "28.1") +(define-obsolete-variable-alias 'display-time-world-timer-enable + 'world-clock-timer-enable "28.1") +(define-obsolete-variable-alias 'display-time-world-timer-second + 'world-clock-timer-second "28.1") + +(define-obsolete-function-alias 'display-time-world-mode + #'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-timer + #'world-clock-update "28.1") + + +;;; World clock + +(defgroup world-clock nil + "Display a world clock." + :group 'display-time) -(define-derived-mode display-time-world-mode special-mode "World clock" +(defcustom zoneinfo-style-world-list + '(("America/Los_Angeles" "Seattle") + ("America/New_York" "New York") + ("Europe/London" "London") + ("Europe/Paris" "Paris") + ("Asia/Calcutta" "Bangalore") + ("Asia/Tokyo" "Tokyo")) + "Alist of zoneinfo-style time zones and places for `world-clock'. +Each element has the form (TIMEZONE LABEL). +TIMEZONE should be a string of the form AREA/LOCATION, where AREA is +the name of a region -- a continent or ocean, and LOCATION is the name +of a specific location, e.g., a city, within that region. +LABEL is a string to display as the label of that TIMEZONE's time." + :type '(repeat (list string string)) + :version "23.1") + +(defcustom legacy-style-world-list + '(("PST8PDT" "Seattle") + ("EST5EDT" "New York") + ("GMT0BST" "London") + ("CET-1CDT" "Paris") + ("IST-5:30" "Bangalore") + ("JST-9" "Tokyo")) + "Alist of traditional-style time zones and places for `world-clock'. +Each element has the form (TIMEZONE LABEL). +TIMEZONE should be a string of the form: + + std[+|-]offset[dst[offset][,date[/time],date[/time]]] + +See the documentation of the TZ environment variable on your system, +for more details about the format of TIMEZONE. +LABEL is a string to display as the label of that TIMEZONE's time." + :type '(repeat (list string string)) + :version "23.1") + +(defcustom world-clock-list t + "Alist of time zones and places for `world-clock' to display. +Each element has the form (TIMEZONE LABEL). +TIMEZONE should be in a format supported by your system. See the +documentation of `zoneinfo-style-world-list' and +`legacy-style-world-list' for two widely used formats. LABEL is +a string to display as the label of that TIMEZONE's time. + +If the value is t instead of an alist, use the value of +`zoneinfo-style-world-list' if it works on this platform, and of +`legacy-style-world-list' otherwise." + :type '(choice (const :tag "Default" t) + (repeat :tag "List of zones and labels" + (list (string :tag "Zone") (string :tag "Label")))) + :version "28.1") + +(defun time--display-world-list () + (if (listp world-clock-list) + world-clock-list + ;; Determine if zoneinfo style timezones are supported by testing that + ;; America/New York and Europe/London return different timezones. + (let ((nyt (format-time-string "%z" nil "America/New_York")) + (gmt (format-time-string "%z" nil "Europe/London"))) + (if (string-equal nyt gmt) + legacy-style-world-list + zoneinfo-style-world-list)))) + +(defcustom world-clock-time-format "%A %d %B %R %Z" + "Time format for `world-clock', see `format-time-string'." + :type 'string + :version "28.1") + +(defcustom world-clock-buffer-name "*wclock*" + "Name of the `world-clock' buffer." + :type 'string + :version "28.1") + +(defcustom world-clock-timer-enable t + "If non-nil, a timer will update the `world-clock' buffer." + :type 'boolean + :version "28.1") + +(defcustom world-clock-timer-second 60 + "Interval in seconds for updating the `world-clock' buffer." + :type 'integer + :version "28.1") + +(defface world-clock-label + '((t :inherit font-lock-variable-name-face)) + "Face for time zone label in `world-clock' buffer.") + +(define-derived-mode world-clock-mode special-mode "World clock" "Major mode for buffer that displays times in various time zones. -See `display-time-world'." +See `world-clock'." + (setq-local revert-buffer-function #'world-clock-update) (setq show-trailing-whitespace nil)) -(defun display-time-world-display (alist) +(defun world-clock-display (alist) "Replace current buffer text with times in various zones, based on ALIST." (let ((inhibit-read-only t) (buffer-undo-list t) @@ -526,42 +535,49 @@ See `display-time-world'." (let* ((label (cadr zone)) (width (string-width label))) (push (cons label - (format-time-string display-time-world-time-format + (format-time-string world-clock-time-format now (car zone))) result) (when (> width max-width) (setq max-width width)))) (setq fmt (concat "%-" (int-to-string max-width) "s %s\n")) (dolist (timedata (nreverse result)) - (insert (format fmt (car timedata) (cdr timedata)))) + (insert (format fmt + (propertize (car timedata) + 'face 'world-clock-label) + (cdr timedata)))) (delete-char -1)) (goto-char (point-min))) +;; Old name -- preserved for backwards compatibility. +;;;###autoload +(defalias 'display-time-world #'world-clock) + ;;;###autoload -(defun display-time-world () - "Enable updating display of times in various time zones. -`display-time-world-list' specifies the zones. -To turn off the world time display, go to that window and type `q'." +(defun world-clock () + "Display a world clock buffer with times in various time zones. +The variable `world-clock-list' specifies which time zones to use. +To turn off the world time display, go to the window and type `\\[quit-window]'." (interactive) - (when (and display-time-world-timer-enable - (not (get-buffer display-time-world-buffer-name))) - (run-at-time t display-time-world-timer-second 'display-time-world-timer)) - (with-current-buffer (get-buffer-create display-time-world-buffer-name) - (display-time-world-display (time--display-world-list)) - (display-buffer display-time-world-buffer-name - (cons nil '((window-height . fit-window-to-buffer)))) - (display-time-world-mode))) - -(defun display-time-world-timer () - (if (get-buffer display-time-world-buffer-name) - (with-current-buffer (get-buffer display-time-world-buffer-name) - (display-time-world-display (time--display-world-list))) + (when (and world-clock-timer-enable + (not (get-buffer world-clock-buffer-name))) + (run-at-time t world-clock-timer-second #'world-clock-update)) + (pop-to-buffer world-clock-buffer-name) + (world-clock-display (time--display-world-list)) + (world-clock-mode) + (fit-window-to-buffer)) + +(defun world-clock-update (&optional _arg _noconfirm) + "Update the `world-clock' buffer." + (if (get-buffer world-clock-buffer-name) + (with-current-buffer (get-buffer world-clock-buffer-name) + (world-clock-display (time--display-world-list))) ;; cancel timer (let ((list timer-list)) (while list (let ((elt (pop list))) (when (equal (symbol-name (timer--function elt)) - "display-time-world-timer") + "world-clock-update") (cancel-timer elt))))))) ;;;###autoload diff --git a/lisp/tooltip.el b/lisp/tooltip.el index f35f6b9a03e..5f5a4788b26 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -167,8 +167,6 @@ This variable has effect only on GUI frames." ;;; Variables that are not customizable. -(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1") - (defvar tooltip-functions nil "Functions to call to display tooltips. Each function is called with one argument EVENT which is a copy diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index f34ef810c4a..be9b5426dc4 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el @@ -120,7 +120,7 @@ path components followed by `..' are removed, along with the `..' itself." ;; Well, they told us the scheme, let's just go with it. nil (setf (url-type urlobj) (or (url-type urlobj) (url-type defobj))) - (setf (url-port urlobj) (or (url-portspec urlobj) + (setf (url-portspec urlobj) (or (url-portspec urlobj) (and (string= (url-type urlobj) (url-type defobj)) (url-port defobj)))) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 331152808fd..1c3607bb661 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -339,8 +339,7 @@ if it had been inserted from a file named URL." (decode-coding-inserted-region (point-min) (point) url visit beg end replace)) (let ((inserted (car size-and-charset))) - (list url (or (and (fboundp 'after-insert-file-set-coding) - (after-insert-file-set-coding inserted visit)) + (list url (or (after-insert-file-set-coding inserted visit) inserted)))))) ;;;###autoload diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 6dd7a9c2aac..0a7e7e205e0 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -569,31 +569,6 @@ Has a preference for looking backward when not directly on a symbol." (setq url nil)) url))) -(defun url-generate-unique-filename (&optional fmt) - "Generate a unique filename in `url-temporary-directory'." - (declare (obsolete make-temp-file "23.1")) - ;; This variable is obsolete, but so is this function. - (let ((tempdir (with-no-warnings url-temporary-directory))) - (if (not fmt) - (let ((base (format "url-tmp.%d" (user-real-uid))) - (fname "") - (x 0)) - (setq fname (format "%s%d" base x)) - (while (file-exists-p - (expand-file-name fname tempdir)) - (setq x (1+ x) - fname (concat base (int-to-string x)))) - (expand-file-name fname tempdir)) - (let ((base (concat "url" (int-to-string (user-real-uid)))) - (fname "") - (x 0)) - (setq fname (format fmt (concat base (int-to-string x)))) - (while (file-exists-p - (expand-file-name fname tempdir)) - (setq x (1+ x) - fname (format fmt (concat base (int-to-string x))))) - (expand-file-name fname tempdir))))) - (defun url-extract-mime-headers () "Set `url-current-mime-headers' in current buffer." (save-excursion diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index d9277cf6f42..e35823ab9af 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -312,13 +312,6 @@ Applies when a protected document is denied by the server." :type 'integer :group 'url) -(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp") - "Where temporary files go." - :type 'directory - :group 'url-file) -(make-obsolete-variable 'url-temporary-directory - 'temporary-file-directory "23.1") - (defcustom url-show-status t "Whether to show a running total of bytes transferred. Can cause a large hit if using a remote X display over a slow link, or diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index d194d6c0a0e..aff20b6e6e9 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1988,8 +1988,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 () @@ -2518,7 +2517,7 @@ fixed, visit it in a buffer." '((?+ . (left-fringe diff-fringe-add diff-indicator-added)) (?- . (left-fringe diff-fringe-del diff-indicator-removed)) (?! . (left-fringe diff-fringe-rep diff-indicator-changed)) - (?\s . (left-fringe diff-fringe-nul)))))) + (?\s . (left-fringe diff-fringe-nul fringe)))))) (put-text-property (match-beginning 0) (match-end 0) 'display spec)))) ;; Mimicks the output of Magit's diff. ;; FIXME: This has only been tested with Git's diff output. diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index da6509b7cbe..04926af16ef 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -1513,21 +1513,6 @@ This default should work without changes." (defsubst ediff-nonempty-string-p (string) (and (stringp string) (not (string= string "")))) -(unless (fboundp 'subst-char-in-string) - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. -Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> i 0) - (setq i (1- i)) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr))) - -(unless (fboundp 'format-message) - (defalias 'format-message 'format)) - (defun ediff-abbrev-jobname (jobname) (cond ((eq jobname 'ediff-directories) "Compare two directories") @@ -1588,9 +1573,8 @@ Unless optional argument INPLACE is non-nil, return a new string." (defun ediff-convert-standard-filename (fname) - (if (fboundp 'convert-standard-filename) - (convert-standard-filename fname) - fname)) + (declare (obsolete convert-standard-filename "28.1")) + (convert-standard-filename fname)) (define-obsolete-function-alias 'ediff-with-syntax-table #'with-syntax-table "27.1") diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 4a84c1ecd9c..f56d31c7136 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -240,18 +240,16 @@ to invocation.") startup-hooks setup-parameters &optional merge-buffer-file) (run-hooks 'ediff-before-setup-hook) - ;; ediff-convert-standard-filename puts file names in the form appropriate + ;; convert-standard-filename puts file names in the form appropriate ;; for the OS at hand. - (setq file-A (ediff-convert-standard-filename (expand-file-name file-A))) - (setq file-B (ediff-convert-standard-filename (expand-file-name file-B))) + (setq file-A (convert-standard-filename (expand-file-name file-A))) + (setq file-B (convert-standard-filename (expand-file-name file-B))) (if (stringp file-C) - (setq file-C - (ediff-convert-standard-filename (expand-file-name file-C)))) + (setq file-C (convert-standard-filename (expand-file-name file-C)))) (if (stringp merge-buffer-file) (progn (setq merge-buffer-file - (ediff-convert-standard-filename - (expand-file-name merge-buffer-file))) + (convert-standard-filename (expand-file-name merge-buffer-file))) ;; check the directory exists (or (file-exists-p (file-name-directory merge-buffer-file)) (error "Directory %s given as place to save the merge doesn't exist" @@ -3069,10 +3067,8 @@ Hit \\[ediff-recenter] to reset the windows afterward." ;; for compatibility -(defmacro ediff-minibuffer-with-setup-hook (fun &rest body) - `(if (fboundp 'minibuffer-with-setup-hook) - (minibuffer-with-setup-hook ,fun ,@body) - ,@body)) +(define-obsolete-function-alias 'ediff-minibuffer-with-setup-hook + #'minibuffer-with-setup-hook "28.1") ;; This is adapted from a similar function in `emerge.el'. ;; PROMPT should not have a trailing ': ', so that it can be modified @@ -3101,7 +3097,7 @@ Hit \\[ediff-recenter] to reset the windows afterward." (and default-file (list default-file)) default-dir))) f) - (setq f (ediff-minibuffer-with-setup-hook + (setq f (minibuffer-with-setup-hook (lambda () (when defaults (setq minibuffer-default defaults))) (read-file-name @@ -3134,7 +3130,7 @@ Hit \\[ediff-recenter] to reset the windows afterward." ;; Also, save buffer from START to END in the file. ;; START defaults to (point-min), END to (point-max) (defun ediff-make-temp-file (buff &optional prefix given-file start end) - (let* ((p (ediff-convert-standard-filename (or prefix "ediff"))) + (let* ((p (convert-standard-filename (or prefix "ediff"))) (short-p p) (coding-system-for-write ediff-coding-system-for-write) f short-f) 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/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index e0cf9e79595..84aeb0a1105 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -210,6 +210,16 @@ toggle display of the entire list." widget)))) :version "27.1") +(defcustom vc-git-revision-complete-only-branches nil + "Control whether tags are returned by revision completion for Git. + +When non-nil, only branches and remotes will be returned by +`vc-git-revision-completion-table'. This is used by various VC +commands when completing branch names. When nil, tags are also +included in the completions." + :type 'boolean + :version "28.1") + ;; History of Git commands. (defvar vc-git-history nil) @@ -243,7 +253,7 @@ toggle display of the entire list." ;; path specs. ;; See also: http://marc.info/?l=git&m=125787684318129&w=2 (name (file-relative-name file dir)) - (str (ignore-errors + (str (with-demoted-errors "Error: %S" (cd dir) (vc-git--out-ok "ls-files" "-c" "-z" "--" name) ;; If result is empty, use ls-tree to check for deleted @@ -1415,9 +1425,11 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (with-temp-buffer (vc-git-command t nil nil "for-each-ref" "--format=%(refname)") (goto-char (point-min)) - (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$" - nil t) - (push (match-string 2) table))) + (let ((regexp (if vc-git-revision-complete-only-branches + "^refs/\\(heads\\|remotes\\)/\\(.*\\)$" + "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"))) + (while (re-search-forward regexp nil t) + (push (match-string 2) table)))) table)) (defun vc-git-revision-completion-table (files) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 95ced7b8d09..cb0657e70a0 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -186,6 +186,16 @@ highlighting the Log View buffer." :group 'vc-hg :version "24.5") +(defcustom vc-hg-create-bookmark t + "This controls whether `vc-create-tag' will create a bookmark or branch. +If nil, named branch will be created. +If t, bookmark will be created. +If `ask', you will be prompted for a branch type." + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Ask" ask)) + :version "28.1") + ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -625,10 +635,18 @@ Optional arg REVISION is a revision to annotate from." ;;; Tag system (defun vc-hg-create-tag (dir name branchp) - "Attach the tag NAME to the state of the working copy." + "Create tag NAME in repo in DIR. Create branch if BRANCHP. +Variable `vc-hg-create-bookmark' controls what kind of branch will be created." (let ((default-directory dir)) - (and (vc-hg-command nil 0 nil "status") - (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name)))) + (vc-hg-command nil 0 nil + (if branchp + (if (if (eq vc-hg-create-bookmark 'ask) + (yes-or-no-p "Create bookmark instead of branch? ") + vc-hg-create-bookmark) + "bookmark" + "branch") + "tag") + name))) (defun vc-hg-retrieve-tag (dir name _update) "Retrieve the version tagged by NAME of all registered files at or below DIR." @@ -1366,25 +1384,28 @@ REV is the revision to check out into WORKFILE." (vc-run-delayed (vc-hg-after-dir-status update-function))) -(defun vc-hg-dir-extra-header (name &rest commands) - (concat (propertize name 'face 'font-lock-type-face) - (propertize - (with-temp-buffer - (apply 'vc-hg-command (current-buffer) 0 nil commands) - (buffer-substring-no-properties (point-min) (1- (point-max)))) - 'face 'font-lock-variable-name-face))) - (defun vc-hg-dir-extra-headers (dir) - "Generate extra status headers for a Mercurial tree." + "Generate extra status headers for a repository in DIR. +This runs the command \"hg summary\"." (let ((default-directory dir)) - (concat - (vc-hg-dir-extra-header "Root : " "root") "\n" - (vc-hg-dir-extra-header "Branch : " "id" "-b") "\n" - (vc-hg-dir-extra-header "Tags : " "id" "-t") ; "\n" - ;; these change after each commit - ;; (vc-hg-dir-extra-header "Local num : " "id" "-n") "\n" - ;; (vc-hg-dir-extra-header "Global id : " "id" "-i") - ))) + (with-temp-buffer + (vc-hg-command t 0 nil "summary") + (goto-char (point-min)) + (mapconcat + #'identity + (let (result) + (while (not (eobp)) + (push + (let ((entry (if (looking-at "\\([^ ].*\\): \\(.*\\)") + (cons (capitalize (match-string 1)) (match-string 2)) + (cons "" (buffer-substring (point) (line-end-position)))))) + (concat + (propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face) + (propertize (cdr entry) 'face 'font-lock-variable-name-face))) + result) + (forward-line)) + (nreverse result)) + "\n")))) (defun vc-hg-log-incoming (buffer remote-location) (vc-setup-buffer buffer) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index ce72a49b955..f09ceddcb37 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -505,14 +505,6 @@ If FILE is not registered, this function always returns nil." (vc-call-backend backend 'working-revision file)))))) -;; Backward compatibility. -(define-obsolete-function-alias - 'vc-workfile-version 'vc-working-revision "23.1") -(defun vc-default-working-revision (backend file) - (message - "`working-revision' not found: using the old `workfile-version' instead") - (vc-call-backend backend 'workfile-version file)) - (defun vc-default-registered (backend file) "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates." (let ((sym (vc-make-backend-sym backend 'master-templates))) diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index 092d8b53968..3c26ffc0e58 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -60,7 +60,6 @@ switches." :version "25.1" :group 'vc-mtn) -(define-obsolete-variable-alias 'vc-mtn-command 'vc-mtn-program "23.1") (defcustom vc-mtn-program "mtn" "Name of the monotone executable." :type 'string diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index db127ee726d..4eb638978a9 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -146,6 +146,20 @@ For a description of possible values, see `vc-check-master-templates'." (progn (defun vc-src-registered (f) (vc-default-registered 'src f))) +(defun vc-src--parse-state (out) + (when (null (string-match "does not exist or is unreadable" out)) + (let ((state (aref out 0))) + (cond + ;; FIXME: What to do about L code? + ((eq state ?.) 'up-to-date) + ((eq state ?A) 'added) + ((eq state ?M) 'edited) + ((eq state ?I) 'ignored) + ((eq state ?R) 'removed) + ((eq state ?!) 'missing) + ((eq state ??) 'unregistered) + (t 'up-to-date))))) + (defun vc-src-state (file) "SRC-specific version of `vc-state'." (let* @@ -163,32 +177,41 @@ For a description of possible values, see `vc-check-master-templates'." "status" "-a" (file-relative-name file)) (error nil))))))) (when (eq 0 status) - (when (null (string-match "does not exist or is unreadable" out)) - (let ((state (aref out 0))) - (cond - ;; FIXME: What to do about A and L codes? - ((eq state ?.) 'up-to-date) - ((eq state ?A) 'added) - ((eq state ?M) 'edited) - ((eq state ?I) 'ignored) - ((eq state ?R) 'removed) - ((eq state ?!) 'missing) - ((eq state ??) 'unregistered) - (t 'up-to-date))))))) + (vc-src--parse-state out)))) (autoload 'vc-expand-dirs "vc") (defun vc-src-dir-status-files (dir files update-function) - ;; FIXME: Use one src status -a call for this - (if (not files) (setq files (vc-expand-dirs (list dir) 'SRC))) - (let ((result nil)) - (dolist (file files) - (let ((state (vc-state file)) - (frel (file-relative-name file))) - (when (and (eq (vc-backend file) 'SRC) - (not (eq state 'up-to-date))) - (push (list frel state) result)))) - (funcall update-function result))) + (let* ((result nil) + (status nil) + (default-directory (or dir default-directory)) + (out + (with-output-to-string + (with-current-buffer standard-output + (setq status + (ignore-errors + (apply + #'process-file vc-src-program nil t nil + "status" "-a" + (mapcar #'file-relative-name files))))))) + dlist) + (when (eq 0 status) + (dolist (line (split-string out "[\n\r]" t)) + (let* ((pair (split-string line "[\t]" t)) + (state (vc-src--parse-state (car pair))) + (frel (cadr pair))) + (if (file-directory-p frel) + (push frel dlist) + (when (not (eq state 'up-to-date)) + (push (list frel state) result))))) + (dolist (drel dlist) + (let ((dresult (vc-src-dir-status-files + (expand-file-name drel) nil #'identity))) + (dolist (dres dresult) + (push (list (concat (file-name-as-directory drel) (car dres)) + (cadr dres)) + result)))) + (funcall update-function result)))) (defun vc-src-command (buffer file-or-list &rest flags) "A wrapper around `vc-do-command' for use in vc-src.el. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 65775f8e46e..5561292d8c0 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2710,9 +2710,6 @@ to the working revision (except for keyword expansion)." (message "Reverting %s...done" (vc-delistify files))))) ;;;###autoload -(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1") - -;;;###autoload (defun vc-pull (&optional arg) "Update the current fileset or branch. You must be visiting a version controlled file, or in a `vc-dir' buffer. diff --git a/lisp/vcursor.el b/lisp/vcursor.el index fa0cbb74b0d..3601abcd6e4 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -1132,9 +1132,6 @@ line is treated like ordinary characters." (vcursor-copy (if (or (= count 0) arg) (1+ count) count))) ) -(define-obsolete-function-alias - 'vcursor-toggle-vcursor-map 'vcursor-use-vcursor-map "23.1") - (defun vcursor-post-command () (and vcursor-auto-disable (not vcursor-last-command) vcursor-overlay diff --git a/lisp/vt-control.el b/lisp/vt-control.el index fc3a514f921..d4c14197bdc 100644 --- a/lisp/vt-control.el +++ b/lisp/vt-control.el @@ -1,4 +1,4 @@ -;;; vt-control.el --- Common VTxxx control functions +;;; vt-control.el --- Common VTxxx control functions -*- lexical-binding:t -*- ;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el index 7552fbb99c1..1e81dd241f1 100644 --- a/lisp/vt100-led.el +++ b/lisp/vt100-led.el @@ -1,4 +1,4 @@ -;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones +;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones -*- lexical-binding:t -*- ;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 47434bf3d2e..8a1bb8ade87 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -262,7 +262,7 @@ ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; code: +;;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -283,7 +283,8 @@ '(face tabs spaces trailing lines space-before-tab newline indentation empty space-after-tab - space-mark tab-mark newline-mark) + space-mark tab-mark newline-mark + missing-newline-at-eof) "Specify which kind of blank is visualized. It's a list containing some or all of the following values: @@ -326,6 +327,11 @@ It's a list containing some or all of the following values: It has effect only if `face' (see above) is present in `whitespace-style'. + missing-newline-at-eof Missing newline at the end of the file is + visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. + empty empty lines at beginning and/or end of buffer are visualized via faces. It has effect only if `face' (see above) @@ -586,6 +592,10 @@ line. Used when `whitespace-style' includes the value `indentation'.") "Face used to visualize big indentation." :group 'whitespace) +(defface whitespace-missing-newline-at-eof + '((((class mono)) :inverse-video t :weight bold :underline t) + (t :background "#d0d040" :foreground "black")) + "Face used to visualize missing newline at the end of the file.") (defvar whitespace-empty 'whitespace-empty "Symbol face used to visualize empty lines at beginning and/or end of buffer. @@ -1700,6 +1710,8 @@ cleaning up these problems." (whitespace-space-after-tab-regexp 'tab)) ((eq (car option) 'space-after-tab::space) (whitespace-space-after-tab-regexp 'space)) + ((eq (car option) 'missing-newline-at-eof) + "[^\n]\\'") (t (cdr option))))) (when (re-search-forward regexp rend t) @@ -2122,7 +2134,16 @@ resultant list will be returned." ((memq 'space-after-tab::space whitespace-active-style) ;; Show SPACEs after TAB (TABs). (whitespace-space-after-tab-regexp 'space))) - 1 whitespace-space-after-tab t))))) + 1 whitespace-space-after-tab t))) + ,@(when (memq 'missing-newline-at-eof whitespace-active-style) + ;; Show missing newline. + `(("[^\n]\\'" 0 + ;; Don't mark the end of the buffer is point is there -- + ;; it probably means that the user is typing something + ;; at the end of the buffer. + (and (/= whitespace-point (point-max)) + 'whitespace-missing-newline-at-eof) + t))))) (font-lock-add-keywords nil whitespace-font-lock-keywords t) (font-lock-flush))) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 284fd1d6cbd..ea7e266e0d0 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -577,6 +577,63 @@ respectively." (if (and widget (funcall function widget maparg)) (setq overlays nil))))) +(defun widget-describe (&optional widget-or-pos) + "Describe the widget at point. +Displays a buffer with information about the widget (e.g., its actions) as well +as a link to browse all the properties of the widget. + +This command resolves the indirection of widgets running the action of its +parents, so the real action executed can be known. + +When called from Lisp, pass WIDGET-OR-POS as the widget to describe, +or a buffer position where a widget is present. If WIDGET-OR-POS is nil, +the widget at point is the widget to describe." + (interactive "d") + (require 'wid-browse) ; The widget-browse widget. + (let ((widget (if (widgetp widget-or-pos) + widget-or-pos + (widget-at widget-or-pos))) + props) + (when widget + (help-setup-xref (list #'widget-describe widget) + (called-interactively-p 'interactive)) + (setq props (list (cons 'action (widget--resolve-parent-action widget)) + (cons 'mouse-down-action + (widget-get widget :mouse-down-action)))) + (with-help-window (help-buffer) + (with-current-buffer (help-buffer) + (widget-insert "This widget's type is ") + (widget-create 'widget-browse :format "%[%v%]\n%d" + :doc (get (car widget) 'widget-documentation) + :help-echo "Browse this widget's properties" + widget) + (dolist (action '(action mouse-down-action)) + (let ((name (symbol-name action)) + (val (alist-get action props))) + (when (functionp val) + (widget-insert "\n\n" (propertize (capitalize name) 'face 'bold) + "'\nThe " name " of this widget is") + (if (symbolp val) + (progn (widget-insert " ") + (widget-create 'function-link :value val + :button-prefix "" :button-suffix "" + :help-echo "Describe this function")) + (widget-insert "\n") + (princ val))))))) + (widget-setup) + t))) + +(defun widget--resolve-parent-action (widget) + "Resolve the real action of WIDGET up its inheritance chain. +Follow the WIDGET's parents, until its :action is no longer +`widget-parent-action', and return its value." + (let ((action (widget-get widget :action)) + (parent (widget-get widget :parent))) + (while (eq action 'widget-parent-action) + (setq parent (widget-get parent :parent) + action (widget-get parent :action))) + action)) + ;;; Images. (defcustom widget-image-directory (file-name-as-directory diff --git a/lisp/window.el b/lisp/window.el index f20940fa0ea..bb34a6d7b4c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2642,12 +2642,17 @@ and no others." "Return t if WINDOW is the currently active minibuffer window." (and (window-live-p window) (eq window (active-minibuffer-window)))) -(defun count-windows (&optional minibuf) +(defun count-windows (&optional minibuf all-frames) "Return the number of live windows on the selected frame. + The optional argument MINIBUF specifies whether the minibuffer -window shall be counted. See `walk-windows' for the precise -meaning of this argument." - (length (window-list-1 nil minibuf))) +window is included in the count. + +If ALL-FRAMES is non-nil, count the windows in all frames instead +just the selected frame. + +See `walk-windows' for the precise meaning of this argument." + (length (window-list-1 nil minibuf all-frames))) ;;; Resizing windows. (defun window--size-to-pixel (window size &optional horizontal pixelwise round-maybe) @@ -5729,10 +5734,10 @@ window." WINDOW defaults to the selected window. DIRECTION can be nil (i.e. any), `height' or `width'." (with-current-buffer (window-buffer window) - (when (and (boundp 'window-size-fixed) window-size-fixed) - (not (and direction - (member (cons direction window-size-fixed) - '((height . width) (width . height)))))))) + (and window-size-fixed + (not (and direction + (member (cons direction window-size-fixed) + '((height . width) (width . height)))))))) ;;; A different solution to balance-windows. (defvar window-area-factor 1 diff --git a/lisp/woman.el b/lisp/woman.el index c0e27c57077..891a1263ace 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -914,8 +914,8 @@ Troff emulation is experimental and largely untested. :group 'faces) (defcustom woman-fontify - (or (and (fboundp 'display-color-p) (display-color-p)) - (and (fboundp 'display-graphic-p) (display-graphic-p)) + (or (display-color-p) + (display-graphic-p) (x-display-color-p)) "If non-nil then WoMan assumes that face support is available. It defaults to a non-nil value if the display supports either colors diff --git a/lisp/xwidget.el b/lisp/xwidget.el index aed6c09122c..074320855c5 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -41,7 +41,10 @@ (declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height)) (declare-function xwidget-webkit-execute-script "xwidget.c" (xwidget script &optional callback)) +(declare-function xwidget-webkit-uri "xwidget.c" (xwidget)) +(declare-function xwidget-webkit-title "xwidget.c" (xwidget)) (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri)) +(declare-function xwidget-webkit-goto-history "xwidget.c" (xwidget rel-pos)) (declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor)) (declare-function xwidget-plist "xwidget.c" (xwidget)) (declare-function set-xwidget-plist "xwidget.c" (xwidget plist)) @@ -51,6 +54,10 @@ (declare-function get-buffer-xwidgets "xwidget.c" (buffer)) (declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget)) +(defgroup xwidget nil + "Displaying native widgets in Emacs buffers." + :group 'widgets) + (defun xwidget-insert (pos type title width height &optional args) "Insert an xwidget at position POS. Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT. @@ -78,6 +85,8 @@ This returns the result of `make-xwidget'." ;;; webkit support (require 'browse-url) (require 'image-mode);;for some image-mode alike functionality +(require 'seq) +(require 'url-handlers) ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) @@ -99,6 +108,24 @@ Interactively, URL defaults to the string looking like a url around point." (xwidget-webkit-new-session url) (xwidget-webkit-goto-url url)))) +(defun xwidget-webkit-clone-and-split-below () + "Clone current URL into a new widget place in new window below. +Get the URL of current session, then browse to the URL +in `split-window-below' with a new xwidget webkit session." + (interactive) + (let ((url (xwidget-webkit-current-url))) + (with-selected-window (split-window-below) + (xwidget-webkit-new-session url)))) + +(defun xwidget-webkit-clone-and-split-right () + "Clone current URL into a new widget place in new window right. +Get the URL of current session, then browse to the URL +in `split-window-right' with a new xwidget webkit session." + (interactive) + (let ((url (xwidget-webkit-current-url))) + (with-selected-window (split-window-right) + (xwidget-webkit-new-session url)))) + ;;todo. ;; - check that the webkit support is compiled in (defvar xwidget-webkit-mode-map @@ -106,6 +133,7 @@ Interactively, URL defaults to the string looking like a url around point." (define-key map "g" 'xwidget-webkit-browse-url) (define-key map "a" 'xwidget-webkit-adjust-size-dispatch) (define-key map "b" 'xwidget-webkit-back) + (define-key map "f" 'xwidget-webkit-forward) (define-key map "r" 'xwidget-webkit-reload) (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!? (define-key map "\C-m" 'xwidget-webkit-insert-string) @@ -115,20 +143,21 @@ Interactively, URL defaults to the string looking like a url around point." ;;similar to image mode bindings (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up) + (define-key map (kbd "S-SPC") 'xwidget-webkit-scroll-down) (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down) - (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up) + (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up-line) (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up) - (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down) + (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down-line) (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down) (define-key map [remap forward-char] 'xwidget-webkit-scroll-forward) (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward) (define-key map [remap right-char] 'xwidget-webkit-scroll-forward) (define-key map [remap left-char] 'xwidget-webkit-scroll-backward) - (define-key map [remap previous-line] 'xwidget-webkit-scroll-down) - (define-key map [remap next-line] 'xwidget-webkit-scroll-up) + (define-key map [remap previous-line] 'xwidget-webkit-scroll-down-line) + (define-key map [remap next-line] 'xwidget-webkit-scroll-up-line) ;; (define-key map [remap move-beginning-of-line] 'image-bol) ;; (define-key map [remap move-end-of-line] 'image-eol) @@ -147,33 +176,63 @@ Interactively, URL defaults to the string looking like a url around point." (interactive) (xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1)) -(defun xwidget-webkit-scroll-up () - "Scroll webkit up." - (interactive) +(defun xwidget-webkit-scroll-up (&optional arg) + "Scroll webkit up by ARG pixels; or full window height if no ARG. +Stop if bottom of page is reached. +Interactively, ARG is the prefix numeric argument. +Negative ARG scrolls down." + (interactive "P") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(0, 50);")) - -(defun xwidget-webkit-scroll-down () - "Scroll webkit down." - (interactive) + (format "window.scrollBy(0, %d);" + (or arg (xwidget-window-inside-pixel-height (selected-window)))))) + +(defun xwidget-webkit-scroll-down (&optional arg) + "Scroll webkit down by ARG pixels; or full window height if no ARG. +Stop if top of page is reached. +Interactively, ARG is the prefix numeric argument. +Negative ARG scrolls up." + (interactive "P") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(0, -50);")) - -(defun xwidget-webkit-scroll-forward () - "Scroll webkit forwards." - (interactive) + (format "window.scrollBy(0, -%d);" + (or arg (xwidget-window-inside-pixel-height (selected-window)))))) + +(defun xwidget-webkit-scroll-up-line (&optional n) + "Scroll webkit up by N lines. +The height of line is calculated with `window-font-height'. +Stop if the bottom edge of the page is reached. +If N is omitted or nil, scroll up by one line." + (interactive "p") + (xwidget-webkit-scroll-up (* n (window-font-height)))) + +(defun xwidget-webkit-scroll-down-line (&optional n) + "Scroll webkit down by N lines. +The height of line is calculated with `window-font-height'. +Stop if the top edge of the page is reached. +If N is omitted or nil, scroll down by one line." + (interactive "p") + (xwidget-webkit-scroll-down (* n (window-font-height)))) + +(defun xwidget-webkit-scroll-forward (&optional n) + "Scroll webkit horizontally by N chars. +The width of char is calculated with `window-font-width'. +If N is ommited or nil, scroll forwards by one char." + (interactive "p") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(50, 0);")) - -(defun xwidget-webkit-scroll-backward () - "Scroll webkit backwards." - (interactive) + (format "window.scrollBy(%d, 0);" + (* n (window-font-width))))) + +(defun xwidget-webkit-scroll-backward (&optional n) + "Scroll webkit back by N chars. +The width of char is calculated with `window-font-width'. +If N is ommited or nil, scroll backwards by one char." + (interactive "p") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(-50, 0);")) + (format "window.scrollBy(-%d, 0);" + (* n (window-font-width))))) (defun xwidget-webkit-scroll-top () "Scroll webkit to the very top." @@ -187,7 +246,7 @@ Interactively, URL defaults to the string looking like a url around point." (interactive) (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollTo(pageXOffset, window.document.body.clientHeight);")) + "window.scrollTo(pageXOffset, window.document.body.scrollHeight);")) ;; The xwidget event needs to go into a higher level handler ;; since the xwidget can generate an event even if it's offscreen. @@ -207,12 +266,8 @@ Interactively, URL defaults to the string looking like a url around point." (let* ((xwidget-event-type (nth 1 last-input-event)) (xwidget (nth 2 last-input-event)) - ;;(xwidget-callback (xwidget-get xwidget 'callback)) - ;;TODO stopped working for some reason - ) - ;;(funcall xwidget-callback xwidget xwidget-event-type) - (message "xw callback %s" xwidget) - (funcall 'xwidget-webkit-callback xwidget xwidget-event-type))) + (xwidget-callback (xwidget-get xwidget 'callback))) + (funcall xwidget-callback xwidget xwidget-event-type))) (defun xwidget-webkit-callback (xwidget xwidget-event-type) "Callback for xwidgets. @@ -222,21 +277,23 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." "error: callback called for xwidget with dead buffer") (with-current-buffer (xwidget-buffer xwidget) (cond ((eq xwidget-event-type 'load-changed) - (xwidget-webkit-execute-script - xwidget "document.title" - (lambda (title) - (xwidget-log "webkit finished loading: '%s'" title) - ;;TODO - check the native/internal scroll - ;;(xwidget-adjust-size-to-content xwidget) - (xwidget-webkit-adjust-size-to-window xwidget) - (rename-buffer (format "*xwidget webkit: %s *" title)))) - (pop-to-buffer (current-buffer))) + (let ((title (xwidget-webkit-title xwidget))) + (xwidget-log "webkit finished loading: %s" title) + ;; Do not adjust webkit size to window here, the selected window + ;; can be the mini-buffer window unwantedly. + (rename-buffer (format "*xwidget webkit: %s *" title) t))) ((eq xwidget-event-type 'decide-policy) (let ((strarg (nth 3 last-input-event))) (if (string-match ".*#\\(.*\\)" strarg) (xwidget-webkit-show-id-or-named-element xwidget (match-string 1 strarg))))) + ;; TODO: Response handling other than download. + ((eq xwidget-event-type 'download-callback) + (let ((url (nth 3 last-input-event)) + (mime-type (nth 4 last-input-event)) + (file-name (nth 5 last-input-event))) + (xwidget-webkit-save-as-file url mime-type file-name))) ((eq xwidget-event-type 'javascript-callback) (let ((proc (nth 3 last-input-event)) (arg (nth 4 last-input-event))) @@ -244,21 +301,66 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))) (defvar bookmark-make-record-function) +(when (memq window-system '(mac ns)) + (defvar xwidget-webkit-enable-plugins nil + "Enable plugins for xwidget webkit. +If non-nil, plugins are enabled. Otherwise, disabled.")) + (define-derived-mode xwidget-webkit-mode - special-mode "xwidget-webkit" "Xwidget webkit view mode." - (setq buffer-read-only t) - (setq-local bookmark-make-record-function - #'xwidget-webkit-bookmark-make-record) - ;; Keep track of [vh]scroll when switching buffers - (image-mode-setup-winprops)) + special-mode "xwidget-webkit" "Xwidget webkit view mode." + (setq buffer-read-only t) + (setq-local bookmark-make-record-function + #'xwidget-webkit-bookmark-make-record) + ;; Keep track of [vh]scroll when switching buffers + (image-mode-setup-winprops)) + +;;; Download, save as file. + +(defcustom xwidget-webkit-download-dir "~/Downloads/" + "Directory where download file saved." + :version "27.1" + :type 'file) + +(defun xwidget-webkit-save-as-file (url mime-type file-name) + "For XWIDGET webkit, save URL of MIME-TYPE to location specified by user. +FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name +of the prompt when reading. When the file name the user specified is a +directory, URL is saved at the specified directory as FILE-NAME." + (let ((save-name (read-file-name + (format "Save URL `%s' of type `%s' in file/directory: " + url mime-type) + xwidget-webkit-download-dir + (when file-name + (expand-file-name + file-name + xwidget-webkit-download-dir))))) + (if (file-directory-p save-name) + (setq save-name + (expand-file-name (file-name-nondirectory file-name) save-name))) + (setq xwidget-webkit-download-dir (file-name-directory save-name)) + (url-copy-file url save-name t))) + +;;; Bookmarks integration + +(defcustom xwidget-webkit-bookmark-jump-new-session nil + "Control bookmark jump to use new session or not. +If non-nil, use a new xwidget webkit session after bookmark jump. +Otherwise, it will use `xwidget-webkit-last-session'. +When you set this variable to nil, consider further customization with +`xwidget-webkit-last-session-buffer'." + :version "27.1" + :type 'boolean) (defun xwidget-webkit-bookmark-make-record () - "Integrate Emacs bookmarks with the webkit xwidget." + "Create bookmark record in webkit xwidget." (nconc (bookmark-make-record-default t t) - `((page . ,(xwidget-webkit-current-url)) - (handler . (lambda (bmk) (browse-url - (bookmark-prop-get bmk 'page))))))) + `((page . ,(xwidget-webkit-uri (xwidget-webkit-current-session))) + (handler . (lambda (bmk) + (xwidget-webkit-browse-url + (bookmark-prop-get bmk 'page) + xwidget-webkit-bookmark-jump-new-session)))))) +;;; xwidget webkit session (defvar xwidget-webkit-last-session-buffer nil) @@ -306,7 +408,7 @@ function findactiveelement(doc){ " - "javascript that finds the active element." + "Javascript that finds the active element." ;; Yes it's ugly, because: ;; - there is apparently no way to find the active frame other than recursion ;; - the js "for each" construct misbehaved on the "frames" collection @@ -316,19 +418,22 @@ function findactiveelement(doc){ ) (defun xwidget-webkit-insert-string () - "Prompt for a string and insert it in the active field in the -current webkit widget." + "Insert string into the active field in the current webkit widget." ;; Read out the string in the field first and provide for edit. (interactive) + ;; As the prompt differs on JavaScript execution results, + ;; the function must handle the prompt itself. (let ((xww (xwidget-webkit-current-session))) (xwidget-webkit-execute-script xww (concat xwidget-webkit-activeelement-js " (function () { var res = findactiveelement(document); - return [res.value, res.type]; + if (res) + return [res.value, res.type]; })();") (lambda (field) + "Prompt a string for the FIELD and insert in the active input." (let ((str (pcase field (`[,val "text"] (read-string "Text: " val)) @@ -447,11 +552,23 @@ For example, use this to display an anchor." (ignore-errors (recenter-top-bottom))) +;; Utility functions + +(defun xwidget-window-inside-pixel-width (window) + "Return Emacs WINDOW body width in pixel." + (let ((edges (window-inside-pixel-edges window))) + (- (nth 2 edges) (nth 0 edges)))) + +(defun xwidget-window-inside-pixel-height (window) + "Return Emacs WINDOW body height in pixel." + (let ((edges (window-inside-pixel-edges window))) + (- (nth 3 edges) (nth 1 edges)))) + (defun xwidget-webkit-adjust-size-to-window (xwidget &optional window) "Adjust the size of the webkit XWIDGET to fit the WINDOW." (xwidget-resize xwidget - (window-pixel-width window) - (window-pixel-height window))) + (xwidget-window-inside-pixel-width window) + (xwidget-window-inside-pixel-height window))) (defun xwidget-webkit-adjust-size (w h) "Manually set webkit size to width W, height H." @@ -481,51 +598,56 @@ For example, use this to display an anchor." (add-to-list 'window-size-change-functions 'xwidget-webkit-adjust-size-in-frame)) -(defun xwidget-webkit-new-session (url) +(defun xwidget-webkit-new-session (url &optional callback) "Create a new webkit session buffer with URL." (let* ((bufname (generate-new-buffer-name "*xwidget-webkit*")) + (callback (or callback #'xwidget-webkit-callback)) xw) (setq xwidget-webkit-last-session-buffer (switch-to-buffer (get-buffer-create bufname))) ;; The xwidget id is stored in a text property, so we need to have ;; at least character in this buffer. - (insert " ") - (setq xw (xwidget-insert 1 'webkit bufname - (window-pixel-width) - (window-pixel-height))) - (xwidget-put xw 'callback 'xwidget-webkit-callback) + ;; Insert invisible url, good default for next `g' to browse url. + (let ((start (point))) + (insert url) + (put-text-property start (+ start (length url)) 'invisible t) + (setq xw (xwidget-insert + start 'webkit bufname + (xwidget-window-inside-pixel-width (selected-window)) + (xwidget-window-inside-pixel-height (selected-window))))) + (xwidget-put xw 'callback callback) (xwidget-webkit-mode) (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url))) (defun xwidget-webkit-goto-url (url) - "Goto URL." + "Goto URL with xwidget webkit." (if (xwidget-webkit-current-session) (progn (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url)) (xwidget-webkit-new-session url))) (defun xwidget-webkit-back () - "Go back in history." + "Go back to previous URL in xwidget webkit buffer." (interactive) - (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "history.go(-1);")) + (xwidget-webkit-goto-history (xwidget-webkit-current-session) -1)) + +(defun xwidget-webkit-forward () + "Go forward in history." + (interactive) + (xwidget-webkit-goto-history (xwidget-webkit-current-session) 1)) (defun xwidget-webkit-reload () - "Reload current url." + "Reload current URL." (interactive) - (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "history.go(0);")) + (xwidget-webkit-goto-history (xwidget-webkit-current-session) 0)) (defun xwidget-webkit-current-url () - "Get the webkit url and place it on the kill-ring." + "Display the current xwidget webkit URL and place it on the `kill-ring'." (interactive) - (xwidget-webkit-execute-script - (xwidget-webkit-current-session) - "document.URL" (lambda (rv) - (let ((url (kill-new (or rv "")))) - (message "url: %s" url))))) + (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session)))) + (message "URL: %s" (kill-new (or url ""))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xwidget-webkit-get-selection (proc) @@ -536,10 +658,9 @@ For example, use this to display an anchor." proc)) (defun xwidget-webkit-copy-selection-as-kill () - "Get the webkit selection and put it on the kill-ring." + "Get the webkit selection and put it on the `kill-ring'." (interactive) - (xwidget-webkit-get-selection (lambda (selection) (kill-new selection)))) - + (xwidget-webkit-get-selection #'kill-new)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Xwidget plist management (similar to the process plist functions) diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4 index 06eff4f3863..14628c363b7 100644 --- a/m4/00gnulib.m4 +++ b/m4/00gnulib.m4 @@ -1,44 +1,12 @@ -# 00gnulib.m4 serial 7 +# 00gnulib.m4 serial 8 dnl Copyright (C) 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. dnl This file must be named something that sorts before all other -dnl gnulib-provided .m4 files. The first part is needed until such time -dnl as we can assume Autoconf 2.64, with its improved AC_DEFUN_ONCE and -dnl m4_divert semantics. The second part is needed until the clang fix -dnl has been included in Autoconf. - -# Until autoconf 2.63, handling of the diversion stack required m4_init -# to be called first; but this does not happen with aclocal. Wrapping -# the entire execution in another layer of the diversion stack fixes this. -# Worse, prior to autoconf 2.62, m4_wrap depended on the underlying m4 -# for whether it was FIFO or LIFO; in order to properly balance with -# m4_init, we need to undo our push just before anything wrapped within -# the m4_init body. The way to ensure this is to wrap both sides of -# m4_init with a one-shot macro that does the pop at the right time. -m4_ifndef([_m4_divert_diversion], -[m4_divert_push([KILL]) -m4_define([gl_divert_fixup], [m4_divert_pop()m4_define([$0])]) -m4_define([m4_init], - [gl_divert_fixup()]m4_defn([m4_init])[gl_divert_fixup()])]) - - -# AC_DEFUN_ONCE([NAME], VALUE) -# ---------------------------- -# Define NAME to expand to VALUE on the first use (whether by direct -# expansion, or by AC_REQUIRE), and to nothing on all subsequent uses. -# Avoid bugs in AC_REQUIRE in Autoconf 2.63 and earlier. This -# definition is slower than the version in Autoconf 2.64, because it -# can only use interfaces that existed since 2.59; but it achieves the -# same effect. Quoting is necessary to avoid confusing Automake. -m4_version_prereq([2.63.263], [], -[m4_define([AC][_DEFUN_ONCE], - [AC][_DEFUN([$1], - [AC_REQUIRE([_gl_DEFUN_ONCE([$1])], - [m4_indir([_gl_DEFUN_ONCE([$1])])])])]dnl -[AC][_DEFUN([_gl_DEFUN_ONCE([$1])], [$2])])]) +dnl gnulib-provided .m4 files. It is needed until the clang fix has +dnl been included in Autoconf. # The following definitions arrange to use a compiler option # -Werror=implicit-function-declaration in AC_CHECK_DECL, when the diff --git a/m4/absolute-header.m4 b/m4/absolute-header.m4 index 39726ba57ba..c043233de36 100644 --- a/m4/absolute-header.m4 +++ b/m4/absolute-header.m4 @@ -1,4 +1,4 @@ -# absolute-header.m4 serial 16 +# absolute-header.m4 serial 17 dnl Copyright (C) 2006-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -22,23 +22,21 @@ dnl From Derek Price. AC_DEFUN([gl_ABSOLUTE_HEADER], [AC_REQUIRE([AC_CANONICAL_HOST]) AC_LANG_PREPROC_REQUIRE()dnl -dnl FIXME: gl_absolute_header and ac_header_exists must be used unquoted -dnl until we can assume autoconf 2.64 or newer. m4_foreach_w([gl_HEADER_NAME], [$1], [AS_VAR_PUSHDEF([gl_absolute_header], [gl_cv_absolute_]m4_defn([gl_HEADER_NAME]))dnl AC_CACHE_CHECK([absolute name of <]m4_defn([gl_HEADER_NAME])[>], - m4_defn([gl_absolute_header]), + [gl_absolute_header], [AS_VAR_PUSHDEF([ac_header_exists], [ac_cv_header_]m4_defn([gl_HEADER_NAME]))dnl AC_CHECK_HEADERS_ONCE(m4_defn([gl_HEADER_NAME]))dnl - if test AS_VAR_GET(ac_header_exists) = yes; then + if test AS_VAR_GET([ac_header_exists]) = yes; then gl_ABSOLUTE_HEADER_ONE(m4_defn([gl_HEADER_NAME])) fi AS_VAR_POPDEF([ac_header_exists])dnl ])dnl AC_DEFINE_UNQUOTED(AS_TR_CPP([ABSOLUTE_]m4_defn([gl_HEADER_NAME])), - ["AS_VAR_GET(gl_absolute_header)"], + ["AS_VAR_GET([gl_absolute_header])"], [Define this to an absolute name of <]m4_defn([gl_HEADER_NAME])[>.]) AS_VAR_POPDEF([gl_absolute_header])dnl ])dnl diff --git a/m4/alloca.m4 b/m4/alloca.m4 index d3e98c51bf4..d8414896308 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -1,4 +1,4 @@ -# alloca.m4 serial 16 +# alloca.m4 serial 18 dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation @@ -50,10 +50,13 @@ AC_DEFUN([gl_FUNC_ALLOCA], # STACK_DIRECTION is already handled by AC_FUNC_ALLOCA. AC_DEFUN([gl_PREREQ_ALLOCA], [:]) -# This works around a bug in autoconf <= 2.68. -# See <https://lists.gnu.org/r/bug-gnulib/2011-06/msg00277.html> and -# <https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=6cd9f12520b0d6f76d3230d7565feba1ecf29497>. -# Also it has a simplification that is not yet in Autoconf. +m4_version_prereq([2.70], [], [ + +# This works around a bug in autoconf <= 2.68 and has simplifications +# from 2.70. See: +# https://lists.gnu.org/r/bug-gnulib/2011-06/msg00277.html +# https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497 +# https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=15edf7fd8094fd14a89d9891dd72a9624762597a # _AC_LIBOBJ_ALLOCA # ----------------- @@ -99,6 +102,7 @@ AH_VERBATIM([STACK_DIRECTION], STACK_DIRECTION > 0 => grows toward higher addresses STACK_DIRECTION < 0 => grows toward lower addresses STACK_DIRECTION = 0 => direction of growth unknown */ -@%:@undef STACK_DIRECTION])dnl +#undef STACK_DIRECTION])dnl AC_DEFINE_UNQUOTED(STACK_DIRECTION, $ac_cv_c_stack_direction) ]) +]) diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4 index bdc5c8f71a7..14ea3e12fa0 100644 --- a/m4/canonicalize.m4 +++ b/m4/canonicalize.m4 @@ -1,4 +1,4 @@ -# canonicalize.m4 serial 31 +# canonicalize.m4 serial 33 dnl Copyright (C) 2003-2007, 2009-2020 Free Software Foundation, Inc. @@ -56,7 +56,16 @@ AC_DEFUN([gl_CANONICALIZE_LGPL], AC_DEFUN([gl_CANONICALIZE_LGPL_SEPARATE], [ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([canonicalize_file_name getcwd readlink]) + AC_CHECK_FUNCS_ONCE([canonicalize_file_name readlink]) + + dnl On native Windows, we use _getcwd(), regardless whether getcwd() is + dnl available through the linker option '-loldnames'. + AC_REQUIRE([AC_CANONICAL_HOST]) + case "$host_os" in + mingw*) ;; + *) AC_CHECK_FUNCS([getcwd]) ;; + esac + AC_REQUIRE([gl_DOUBLE_SLASH_ROOT]) AC_REQUIRE([gl_FUNC_REALPATH_WORKS]) AC_CHECK_HEADERS_ONCE([sys/param.h]) @@ -70,6 +79,7 @@ AC_DEFUN([gl_FUNC_REALPATH_WORKS], AC_CHECK_FUNCS_ONCE([realpath]) AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles AC_CACHE_CHECK([whether realpath works], [gl_cv_func_realpath_works], [ + rm -rf conftest.a conftest.d touch conftest.a mkdir conftest.d AC_RUN_IFELSE([ diff --git a/m4/dup2.m4 b/m4/dup2.m4 index 462bfd0e526..a82798d6bba 100644 --- a/m4/dup2.m4 +++ b/m4/dup2.m4 @@ -1,4 +1,4 @@ -#serial 26 +#serial 27 dnl Copyright (C) 2002, 2005, 2007, 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -16,6 +16,7 @@ AC_DEFUN([gl_FUNC_DUP2], #include <limits.h> #include <sys/resource.h> #include <unistd.h> + ]GL_MDA_DEFINES[ #ifndef RLIM_SAVED_CUR # define RLIM_SAVED_CUR RLIM_INFINITY #endif diff --git a/m4/fchmodat.m4 b/m4/fchmodat.m4 index e3f2f048162..cf5c87999c5 100644 --- a/m4/fchmodat.m4 +++ b/m4/fchmodat.m4 @@ -1,4 +1,4 @@ -# fchmodat.m4 serial 4 +# fchmodat.m4 serial 5 dnl Copyright (C) 2004-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -40,7 +40,7 @@ AC_DEFUN([gl_FUNC_FCHMODAT], #ifndef S_IRWXO #define S_IRWXO 0007 #endif - ]], + ]GL_MDA_DEFINES], [[ int permissive = S_IRWXU | S_IRWXG | S_IRWXO; int desired = S_IRUSR | S_IWUSR; diff --git a/m4/fcntl.m4 b/m4/fcntl.m4 index 562ae2395df..ea24f3d64ef 100644 --- a/m4/fcntl.m4 +++ b/m4/fcntl.m4 @@ -1,4 +1,4 @@ -# fcntl.m4 serial 9 +# fcntl.m4 serial 10 dnl Copyright (C) 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -34,6 +34,7 @@ AC_DEFUN([gl_FUNC_FCNTL], #include <limits.h> #include <sys/resource.h> #include <unistd.h> + ]GL_MDA_DEFINES[ #ifndef RLIM_SAVED_CUR # define RLIM_SAVED_CUR RLIM_INFINITY #endif diff --git a/m4/fdopendir.m4 b/m4/fdopendir.m4 index d9cc1a00173..9937a74ea8d 100644 --- a/m4/fdopendir.m4 +++ b/m4/fdopendir.m4 @@ -1,4 +1,4 @@ -# serial 12 +# serial 14 # See if we need to provide fdopendir. dnl Copyright (C) 2009-2020 Free Software Foundation, Inc. @@ -25,10 +25,12 @@ AC_DEFUN([gl_FUNC_FDOPENDIR], else AC_CACHE_CHECK([whether fdopendir works], [gl_cv_func_fdopendir_works], - [AC_RUN_IFELSE([AC_LANG_PROGRAM([[ + [AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[ #include <dirent.h> #include <fcntl.h> #include <unistd.h> +]GL_MDA_DEFINES[ #if !HAVE_DECL_FDOPENDIR extern # ifdef __cplusplus @@ -36,12 +38,14 @@ extern # endif DIR *fdopendir (int); #endif -]], [int result = 0; - int fd = open ("conftest.c", O_RDONLY); - if (fd < 0) result |= 1; - if (fdopendir (fd)) result |= 2; - if (close (fd)) result |= 4; - return result;])], +]], + [[int result = 0; + int fd = open ("conftest.c", O_RDONLY); + if (fd < 0) result |= 1; + if (fdopendir (fd)) result |= 2; + if (close (fd)) result |= 4; + return result; + ]])], [gl_cv_func_fdopendir_works=yes], [gl_cv_func_fdopendir_works=no], [case "$host_os" in diff --git a/m4/fpending.m4 b/m4/fpending.m4 index ea9725e4890..edabcec5f0b 100644 --- a/m4/fpending.m4 +++ b/m4/fpending.m4 @@ -1,4 +1,4 @@ -# serial 22 +# serial 23 # Copyright (C) 2000-2001, 2004-2020 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation @@ -25,7 +25,7 @@ AC_DEFUN([gl_FUNC_FPENDING], AC_CACHE_CHECK([for __fpending], [gl_cv_func___fpending], [ AC_LINK_IFELSE( - [AC_LANG_PROGRAM([$fp_headers], + [AC_LANG_PROGRAM([[$fp_headers]], [[return ! __fpending (stdin);]])], [gl_cv_func___fpending=yes], [gl_cv_func___fpending=no]) diff --git a/m4/futimens.m4 b/m4/futimens.m4 index dc5cfa94119..145b8ff0d51 100644 --- a/m4/futimens.m4 +++ b/m4/futimens.m4 @@ -1,4 +1,4 @@ -# serial 8 +# serial 9 # See if we need to provide futimens replacement. dnl Copyright (C) 2009-2020 Free Software Foundation, Inc. @@ -24,7 +24,8 @@ AC_DEFUN([gl_FUNC_FUTIMENS], #include <sys/stat.h> #include <unistd.h> #include <errno.h> -]], [[struct timespec ts[2]; +]GL_MDA_DEFINES], + [[struct timespec ts[2]; int fd = creat ("conftest.file", 0600); struct stat st; if (fd < 0) return 1; diff --git a/m4/getdtablesize.m4 b/m4/getdtablesize.m4 index ab2e3feb37b..af328644adb 100644 --- a/m4/getdtablesize.m4 +++ b/m4/getdtablesize.m4 @@ -1,4 +1,4 @@ -# getdtablesize.m4 serial 7 +# getdtablesize.m4 serial 8 dnl Copyright (C) 2008-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -29,13 +29,16 @@ AC_DEFUN([gl_FUNC_GETDTABLESIZE], dnl correctly require setrlimit before getdtablesize() can report dnl a larger value. AC_RUN_IFELSE([ - AC_LANG_PROGRAM([[#include <unistd.h>]], - [int size = getdtablesize(); - if (dup2 (0, getdtablesize()) != -1) - return 1; - if (size != getdtablesize()) - return 2; - ])], + AC_LANG_PROGRAM( + [[#include <unistd.h>] + GL_MDA_DEFINES + ], + [[int size = getdtablesize(); + if (dup2 (0, getdtablesize()) != -1) + return 1; + if (size != getdtablesize()) + return 2; + ]])], [gl_cv_func_getdtablesize_works=yes], [gl_cv_func_getdtablesize_works=no], [case "$host_os" in diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 index 8e96965d828..9fe328efc02 100644 --- a/m4/getloadavg.m4 +++ b/m4/getloadavg.m4 @@ -7,7 +7,7 @@ # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -#serial 9 +#serial 10 # Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent. # New applications should use gl_GETLOADAVG instead. @@ -147,7 +147,7 @@ fi AC_CHECK_HEADERS([nlist.h], [AC_CHECK_MEMBERS([struct nlist.n_un.n_name], [], [], - [@%:@include <nlist.h>]) + [#include <nlist.h>]) AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <nlist.h>]], [[struct nlist x; #ifdef HAVE_STRUCT_NLIST_N_UN_N_NAME diff --git a/m4/getrandom.m4 b/m4/getrandom.m4 index 424c2fad3e3..d6da71a2c83 100644 --- a/m4/getrandom.m4 +++ b/m4/getrandom.m4 @@ -1,4 +1,4 @@ -# getrandom.m4 serial 7 +# getrandom.m4 serial 8 dnl Copyright 2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -18,7 +18,8 @@ AC_DEFUN([gl_FUNC_GETRANDOM], [gl_cv_func_getrandom_ok], [AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( - [[/* Additional includes are needed before <sys/random.h> on Mac OS X. */ + [[/* Additional includes are needed before <sys/random.h> on uClibc + and Mac OS X. */ #include <sys/types.h> #include <stdlib.h> #include <sys/random.h> diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 57f3a780118..33e56faa98e 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 52 +# gnulib-common.m4 serial 57 dnl Copyright (C) 2007-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -45,7 +45,7 @@ AC_DEFUN([gl_COMMON_BODY], [ ? 6000000 <= __apple_build_version__ \ : 3 < __clang_major__ + (5 <= __clang_minor__)))) /* _Noreturn works as-is. */ -# elif _GL_GNUC_PREREQ (2, 8) || 0x5110 <= __SUNPRO_C +# elif _GL_GNUC_PREREQ (2, 8) || defined __clang__ || 0x5110 <= __SUNPRO_C # define _Noreturn __attribute__ ((__noreturn__)) # elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0) # define _Noreturn __declspec (noreturn) @@ -76,6 +76,7 @@ AC_DEFUN([gl_COMMON_BODY], [ # define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3) # define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95) # define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1) +# define _GL_ATTR_diagnose_if 0 # define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3) # define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1) # define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0) @@ -149,6 +150,9 @@ AC_DEFUN([gl_COMMON_BODY], [ #if _GL_HAS_ATTRIBUTE (error) # define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__error__ (msg))) # define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__warning__ (msg))) +#elif _GL_HAS_ATTRIBUTE (diagnose_if) +# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__diagnose_if__ (1, msg, "error"))) +# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__diagnose_if__ (1, msg, "warning"))) #else # define _GL_ATTRIBUTE_ERROR(msg) # define _GL_ATTRIBUTE_WARNING(msg) @@ -300,7 +304,9 @@ AC_DEFUN([gl_COMMON_BODY], [ #define _GL_ASYNC_SAFE ]) AH_VERBATIM([micro_optimizations], -[/* _GL_CMP (n1, n2) performs a three-valued comparison on n1 vs. n2. +[/* _GL_CMP (n1, n2) performs a three-valued comparison on n1 vs. n2, where + n1 and n2 are expressions without side effects, that evaluate to real + numbers (excluding NaN). It returns 1 if n1 > n2 0 if n1 == n2 @@ -474,14 +480,6 @@ AC_DEFUN([gl_FEATURES_H], AC_SUBST([HAVE_FEATURES_H]) ]) -# AS_VAR_IF(VAR, VALUE, [IF-MATCH], [IF-NOT-MATCH]) -# ---------------------------------------------------- -# Backport of autoconf-2.63b's macro. -# Remove this macro when we can assume autoconf >= 2.64. -m4_ifndef([AS_VAR_IF], -[m4_define([AS_VAR_IF], -[AS_IF([test x"AS_VAR_GET([$1])" = x""$2], [$3], [$4])])]) - # gl_PROG_CC_C99 # Modifies the value of the shell variable CC in an attempt to make $CC # understand ISO C99 source code. @@ -654,6 +652,72 @@ AC_DEFUN([gl_CACHE_VAL_SILENT], as_echo_n="$saved_as_echo_n" ]) -# AS_VAR_COPY was added in autoconf 2.63b -m4_define_default([AS_VAR_COPY], -[AS_LITERAL_IF([$1[]$2], [$1=$$2], [eval $1=\$$2])]) +dnl Expands to some code for use in .c programs that, on native Windows, defines +dnl the Microsoft deprecated alias function names to the underscore-prefixed +dnl actual function names. With this macro, these function names are available +dnl without linking with '-loldnames' and without generating warnings. +dnl Usage: Use it after all system header files are included. +dnl #include <...> +dnl #include <...> +dnl ]GL_MDA_DEFINES[ +dnl ... +AC_DEFUN([GL_MDA_DEFINES],[ +AC_REQUIRE([_GL_MDA_DEFINES]) +[$gl_mda_defines] +]) +AC_DEFUN([_GL_MDA_DEFINES], +[gl_mda_defines=' +#if defined _WIN32 && !defined __CYGWIN__ +#define access _access +#define chdir _chdir +#define chmod _chmod +#define close _close +#define creat _creat +#define dup _dup +#define dup2 _dup2 +#define ecvt _ecvt +#define execl _execl +#define execle _execle +#define execlp _execlp +#define execv _execv +#define execve _execve +#define execvp _execvp +#define execvpe _execvpe +#define fcloseall _fcloseall +#define fcvt _fcvt +#define fdopen _fdopen +#define fileno _fileno +#define gcvt _gcvt +#define getcwd _getcwd +#define getpid _getpid +#define getw _getw +#define isatty _isatty +#define j0 _j0 +#define j1 _j1 +#define jn _jn +#define lfind _lfind +#define lsearch _lsearch +#define lseek _lseek +#define memccpy _memccpy +#define mkdir _mkdir +#define mktemp _mktemp +#define open _open +#define putenv _putenv +#define putw _putw +#define read _read +#define rmdir _rmdir +#define strdup _strdup +#define swab _swab +#define tempnam _tempnam +#define tzset _tzset +#define umask _umask +#define unlink _unlink +#define utime _utime +#define wcsdup _wcsdup +#define write _write +#define y0 _y0 +#define y1 _y1 +#define yn _yn +#endif +' +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 4472af81b70..5bfa1473edd 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -346,7 +346,7 @@ AC_DEFUN([gl_INIT], AC_REQUIRE([gl_LARGEFILE]) gl___INLINE gl_LIBGMP - if test -n "$GMP_H"; then + if test $HAVE_LIBGMP != yes; then AC_LIBOBJ([mini-gmp-gnulib]) fi gl_LIMITS_H diff --git a/m4/include_next.m4 b/m4/include_next.m4 index 9009e293b53..33601aa3b43 100644 --- a/m4/include_next.m4 +++ b/m4/include_next.m4 @@ -1,4 +1,4 @@ -# include_next.m4 serial 24 +# include_next.m4 serial 25 dnl Copyright (C) 2006-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -176,42 +176,40 @@ AC_DEFUN([gl_NEXT_HEADERS_INTERNAL], [AC_CHECK_HEADERS_ONCE([$1]) ]) -dnl FIXME: gl_next_header and gl_header_exists must be used unquoted -dnl until we can assume autoconf 2.64 or newer. m4_foreach_w([gl_HEADER_NAME], [$1], [AS_VAR_PUSHDEF([gl_next_header], [gl_cv_next_]m4_defn([gl_HEADER_NAME])) if test $gl_cv_have_include_next = yes; then - AS_VAR_SET(gl_next_header, ['<'gl_HEADER_NAME'>']) + AS_VAR_SET([gl_next_header], ['<'gl_HEADER_NAME'>']) else AC_CACHE_CHECK( [absolute name of <]m4_defn([gl_HEADER_NAME])[>], - m4_defn([gl_next_header]), + [gl_next_header], [m4_if([$2], [check], [AS_VAR_PUSHDEF([gl_header_exists], [ac_cv_header_]m4_defn([gl_HEADER_NAME])) - if test AS_VAR_GET(gl_header_exists) = yes; then + if test AS_VAR_GET([gl_header_exists]) = yes; then AS_VAR_POPDEF([gl_header_exists]) ]) gl_ABSOLUTE_HEADER_ONE(gl_HEADER_NAME) AS_VAR_COPY([gl_header], [gl_cv_absolute_]AS_TR_SH(gl_HEADER_NAME)) - AS_VAR_SET(gl_next_header, ['"'$gl_header'"']) + AS_VAR_SET([gl_next_header], ['"'$gl_header'"']) m4_if([$2], [check], [else - AS_VAR_SET(gl_next_header, ['<'gl_HEADER_NAME'>']) + AS_VAR_SET([gl_next_header], ['<'gl_HEADER_NAME'>']) fi ]) ]) fi AC_SUBST( AS_TR_CPP([NEXT_]m4_defn([gl_HEADER_NAME])), - [AS_VAR_GET(gl_next_header)]) + [AS_VAR_GET([gl_next_header])]) if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next' gl_next_as_first_directive='<'gl_HEADER_NAME'>' else # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' - gl_next_as_first_directive=AS_VAR_GET(gl_next_header) + gl_next_as_first_directive=AS_VAR_GET([gl_next_header]) fi AC_SUBST( AS_TR_CPP([NEXT_AS_FIRST_DIRECTIVE_]m4_defn([gl_HEADER_NAME])), diff --git a/m4/largefile.m4 b/m4/largefile.m4 index 8017ca70eb4..f4c5d3a5cea 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 @@ -30,12 +30,12 @@ m4_version_prereq([2.70], [] ,[ # _AC_SYS_LARGEFILE_TEST_INCLUDES # ------------------------------- m4_define([_AC_SYS_LARGEFILE_TEST_INCLUDES], -[@%:@include <sys/types.h> +[#include <sys/types.h> /* Check that off_t can represent 2**63 - 1 correctly. We can't simply define LARGE_OFF_T to be 9223372036854775807, since some C++ compilers masquerading as C compilers incorrectly reject 9223372036854775807. */ -@%:@define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) +#define LARGE_OFF_T (((off_t) 1 << 31 << 31) - 1 + ((off_t) 1 << 31 << 31)) int off_t_is_large[[(LARGE_OFF_T % 2147483629 == 721 && LARGE_OFF_T % 2147483647 == 1) ? 1 : -1]];[]dnl @@ -54,7 +54,7 @@ m4_define([_AC_SYS_LARGEFILE_MACRO_VALUE], [AC_LANG_PROGRAM([$5], [$6])], [$3=no; break]) m4_ifval([$6], [AC_LINK_IFELSE], [AC_COMPILE_IFELSE])( - [AC_LANG_PROGRAM([@%:@define $1 $2 + [AC_LANG_PROGRAM([#define $1 $2 $5], [$6])], [$3=$2; break]) $3=unknown diff --git a/m4/libgmp.m4 b/m4/libgmp.m4 index 82c065e2c2c..1025f06a775 100644 --- a/m4/libgmp.m4 +++ b/m4/libgmp.m4 @@ -1,4 +1,4 @@ -# libgmp.m4 serial 4 +# libgmp.m4 serial 5 # Configure the GMP library or a replacement. dnl Copyright 2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -18,50 +18,54 @@ AC_DEFUN([gl_LIBGMP], [AS_HELP_STRING([--without-libgmp], [do not use the GNU Multiple Precision (GMP) library; this is the default on systems lacking libgmp.])]) - case "$with_libgmp" in - no) - HAVE_LIBGMP=no - LIBGMP= - LTLIBGMP= - ;; - *) - dnl Prefer AC_LIB_HAVE_LINKFLAGS if the havelib module is also in use. - m4_ifdef([gl_HAVE_MODULE_HAVELIB], - [AC_LIB_HAVE_LINKFLAGS([gmp], [], - [#include <gmp.h>], - [static const mp_limb_t x[2] = { 0x73, 0x55 }; - mpz_t tmp; - mpz_roinit_n (tmp, x, 2); - ], - [no])], - [gl_saved_LIBS=$LIBS - AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) - LIBS=$gl_saved_LIBS - case $ac_cv_search___gmpz_roinit_n in - 'none needed') - HAVE_LIBGMP=yes LIBGMP=;; - -*) - HAVE_LIBGMP=yes LIBGMP=$ac_cv_search___gmpz_roinit_n;; - *) - HAVE_LIBGMP=no LIBGMP=;; - esac - LTLIBGMP=$LIBGMP - AC_SUBST([HAVE_LIBGMP]) - AC_SUBST([LIBGMP]) - AC_SUBST([LTLIBGMP])]) - if test "$with_libgmp,$HAVE_LIBGMP" = yes,no; then - AC_MSG_ERROR( - [GMP not found, although --with-libgmp was specified.m4_ifdef( - [AC_LIB_HAVE_LINKFLAGS], - [ Try specifying --with-libgmp-prefix=DIR.])]) - fi - ;; - esac - if test $HAVE_LIBGMP = yes; then + HAVE_LIBGMP=no + LIBGMP= + LTLIBGMP= + AS_IF([test "$with_libgmp" != no], + [AC_CHECK_HEADERS([gmp.h gmp/gmp.h], [break]) + dnl Prefer AC_LIB_HAVE_LINKFLAGS if the havelib module is also in use. + AS_IF([test "$ac_cv_header_gmp_h" = yes || + test "$ac_cv_header_gmp_gmp_h" = yes], + [m4_ifdef([gl_HAVE_MODULE_HAVELIB], + [AC_LIB_HAVE_LINKFLAGS([gmp], [], + [#if HAVE_GMP_H + # include <gmp.h> + #else + # include <gmp/gmp.h> + #endif], + [static const mp_limb_t x[2] = { 0x73, 0x55 }; + mpz_t tmp; + mpz_roinit_n (tmp, x, 2); + ], + [no])], + [gl_saved_LIBS=$LIBS + AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) + LIBS=$gl_saved_LIBS + case $ac_cv_search___gmpz_roinit_n in + 'none needed') + HAVE_LIBGMP=yes;; + -*) + HAVE_LIBGMP=yes + LIBGMP=$ac_cv_search___gmpz_roinit_n + LTLIBGMP=$LIBGMP;; + esac + AC_SUBST([HAVE_LIBGMP]) + AC_SUBST([LIBGMP]) + AC_SUBST([LTLIBGMP])])]) + if test "$with_libgmp,$HAVE_LIBGMP" = yes,no; then + AC_MSG_ERROR( + [GMP not found, although --with-libgmp was specified.m4_ifdef( + [AC_LIB_HAVE_LINKFLAGS], + [ Try specifying --with-libgmp-prefix=DIR.])]) + fi]) + if test $HAVE_LIBGMP = yes && test "$ac_cv_header_gmp_h" = yes; then GMP_H= else GMP_H=gmp.h fi AC_SUBST([GMP_H]) - AM_CONDITIONAL([GL_GENERATE_GMP_H], [test -n "$GMP_H"]) + AM_CONDITIONAL([GL_GENERATE_MINI_GMP_H], + [test $HAVE_LIBGMP != yes]) + AM_CONDITIONAL([GL_GENERATE_GMP_GMP_H], + [test $HAVE_LIBGMP = yes && test "$ac_cv_header_gmp_h" != yes]) ]) diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index d18da048d9e..a37cd15b69a 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 20 +# manywarnings.m4 serial 21 dnl Copyright (C) 2008-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -39,8 +39,7 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], [_AC_LANG_DISPATCH([$0], _AC_LANG, $@)]) # Specialization for _AC_LANG = C. -# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b. -m4_defun([gl_MANYWARN_ALL_GCC(C)], +AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], [ AC_LANG_PUSH([C]) @@ -210,8 +209,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], ]) # Specialization for _AC_LANG = C++. -# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b. -m4_defun([gl_MANYWARN_ALL_GCC(C++)], +AC_DEFUN([gl_MANYWARN_ALL_GCC(C++)], [ gl_MANYWARN_ALL_GCC_CXX_IMPL([$1]) ]) diff --git a/m4/mktime.m4 b/m4/mktime.m4 index 8d9b827fe21..4e7e423fa54 100644 --- a/m4/mktime.m4 +++ b/m4/mktime.m4 @@ -1,4 +1,4 @@ -# serial 32 +# serial 35 dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation @@ -31,7 +31,6 @@ AC_DEFUN([gl_FUNC_MKTIME_WORKS], dnl in Autoconf and because it invokes AC_LIBOBJ. AC_CHECK_HEADERS_ONCE([unistd.h]) AC_CHECK_DECLS_ONCE([alarm]) - AC_CHECK_FUNCS_ONCE([tzset]) AC_REQUIRE([gl_MULTIARCH]) AC_CACHE_CHECK([for working mktime], [gl_cv_func_working_mktime], [if test $APPLE_UNIVERSAL_BUILD = 1; then @@ -55,13 +54,12 @@ AC_DEFUN([gl_FUNC_MKTIME_WORKS], # include <signal.h> #endif +]GL_MDA_DEFINES[ + #ifndef TIME_T_IS_SIGNED # define TIME_T_IS_SIGNED 0 #endif -/* Work around redefinition to rpl_putenv by other config tests. */ -#undef putenv - static time_t time_t_max; static time_t time_t_min; diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4 index 6f2762aa276..e4eb87de0b9 100644 --- a/m4/nstrftime.m4 +++ b/m4/nstrftime.m4 @@ -1,4 +1,4 @@ -# serial 35 +# serial 36 # Copyright (C) 1996-1997, 1999-2007, 2009-2020 Free Software Foundation, Inc. # @@ -17,8 +17,6 @@ AC_DEFUN([gl_FUNC_GNU_STRFTIME], AC_REQUIRE([gl_TM_GMTOFF]) - AC_CHECK_FUNCS_ONCE([tzset]) - AC_DEFINE([my_strftime], [nstrftime], [Define to the name of the strftime replacement function.]) ]) diff --git a/m4/open-slash.m4 b/m4/open-slash.m4 index 1e57c96960e..5d84f2b548a 100644 --- a/m4/open-slash.m4 +++ b/m4/open-slash.m4 @@ -1,4 +1,4 @@ -# open-slash.m4 serial 1 +# open-slash.m4 serial 2 dnl Copyright (C) 2007-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -25,6 +25,7 @@ AC_DEFUN([gl_OPEN_TRAILING_SLASH_BUG], #if HAVE_UNISTD_H # include <unistd.h> #endif +]GL_MDA_DEFINES[ int main () { int result = 0; diff --git a/m4/pselect.m4 b/m4/pselect.m4 index f3e5afe0b38..08a5823c6f9 100644 --- a/m4/pselect.m4 +++ b/m4/pselect.m4 @@ -1,4 +1,4 @@ -# pselect.m4 serial 8 +# pselect.m4 serial 9 dnl Copyright (C) 2011-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -37,7 +37,8 @@ AC_DEFUN([gl_FUNC_PSELECT], #endif #include <unistd.h> #include <errno.h> -]],[[ +]GL_MDA_DEFINES], +[[ fd_set set; dup2(0, 16); FD_ZERO(&set); diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4 index d67511f73dd..030862de015 100644 --- a/m4/pthread_sigmask.m4 +++ b/m4/pthread_sigmask.m4 @@ -1,4 +1,4 @@ -# pthread_sigmask.m4 serial 18 +# pthread_sigmask.m4 serial 19 dnl Copyright (C) 2011-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -220,6 +220,7 @@ int main () #include <stdio.h> #include <stdlib.h> #include <unistd.h> +]GL_MDA_DEFINES[ static volatile int sigint_occurred; static void sigint_handler (int sig) diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4 index 6bcfadb74ef..d8bc8ff64e4 100644 --- a/m4/stddef_h.m4 +++ b/m4/stddef_h.m4 @@ -1,5 +1,5 @@ dnl A placeholder for <stddef.h>, for platforms that have issues. -# stddef_h.m4 serial 6 +# stddef_h.m4 serial 7 dnl Copyright (C) 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -19,7 +19,7 @@ AC_DEFUN([gl_STDDEF_H], [AC_LANG_PROGRAM( [[#include <stddef.h> unsigned int s = sizeof (max_align_t); - #if defined __GNUC__ || defined __IBM__ALIGNOF__ + #if defined __GNUC__ || defined __clang__ || defined __IBM__ALIGNOF__ int check1[2 * (__alignof__ (double) <= __alignof__ (max_align_t)) - 1]; int check2[2 * (__alignof__ (long double) <= __alignof__ (max_align_t)) - 1]; #endif diff --git a/m4/stdint.m4 b/m4/stdint.m4 index 29ad826d8ea..e0fa8a51fb3 100644 --- a/m4/stdint.m4 +++ b/m4/stdint.m4 @@ -1,4 +1,4 @@ -# stdint.m4 serial 54 +# stdint.m4 serial 55 dnl Copyright (C) 2001-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -152,7 +152,7 @@ uintmax_t j = UINTMAX_MAX; /* Check that SIZE_MAX has the correct type, if possible. */ #if 201112 <= __STDC_VERSION__ int k = _Generic (SIZE_MAX, size_t: 0); -#elif (2 <= __GNUC__ || defined __IBM__TYPEOF__ \ +#elif (2 <= __GNUC__ || 4 <= __clang_major__ || defined __IBM__TYPEOF__ \ || (0x5110 <= __SUNPRO_C && !__STDC__)) extern size_t k; extern __typeof__ (SIZE_MAX) k; diff --git a/m4/sys_random_h.m4 b/m4/sys_random_h.m4 index a964b157841..8c5d53703be 100644 --- a/m4/sys_random_h.m4 +++ b/m4/sys_random_h.m4 @@ -1,4 +1,4 @@ -# sys_random_h.m4 serial 4 +# sys_random_h.m4 serial 5 dnl Copyright (C) 2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -25,7 +25,8 @@ AC_DEFUN([gl_HEADER_SYS_RANDOM], dnl corresponding gnulib module is not in use. gl_WARN_ON_USE_PREPARE([[ #if HAVE_SYS_RANDOM_H -/* Additional includes are needed before <sys/random.h> on Mac OS X. */ +/* Additional includes are needed before <sys/random.h> on uClibc + and Mac OS X. */ # include <sys/types.h> # include <stdlib.h> # include <sys/random.h> diff --git a/m4/time_h.m4 b/m4/time_h.m4 index d0f89327c4b..a15c09dc07b 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -121,7 +121,6 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS], HAVE_NANOSLEEP=1; AC_SUBST([HAVE_NANOSLEEP]) HAVE_STRPTIME=1; AC_SUBST([HAVE_STRPTIME]) HAVE_TIMEGM=1; AC_SUBST([HAVE_TIMEGM]) - HAVE_TZSET=1; AC_SUBST([HAVE_TZSET]) dnl Even GNU libc does not have timezone_t yet. HAVE_TIMEZONE_T=0; AC_SUBST([HAVE_TIMEZONE_T]) dnl If another module says to replace or to not replace, do that. diff --git a/m4/utimens.m4 b/m4/utimens.m4 index 65617ac862c..3d31085fc6d 100644 --- a/m4/utimens.m4 +++ b/m4/utimens.m4 @@ -3,7 +3,7 @@ dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. -dnl serial 10 +dnl serial 11 AC_DEFUN([gl_UTIMENS], [ @@ -24,7 +24,8 @@ AC_DEFUN([gl_UTIMENS], #include <stddef.h> #include <sys/times.h> #include <fcntl.h> -]], [[ int fd = open ("conftest.file", O_RDWR); +]GL_MDA_DEFINES], + [[int fd = open ("conftest.file", O_RDWR); if (fd < 0) return 1; if (futimesat (fd, NULL, NULL)) return 2; ]])], diff --git a/m4/utimensat.m4 b/m4/utimensat.m4 index 2bc1bfebb5d..e9e4f26b1c1 100644 --- a/m4/utimensat.m4 +++ b/m4/utimensat.m4 @@ -1,4 +1,4 @@ -# serial 6 +# serial 7 # See if we need to provide utimensat replacement. dnl Copyright (C) 2009-2020 Free Software Foundation, Inc. @@ -23,7 +23,8 @@ AC_DEFUN([gl_FUNC_UTIMENSAT], #include <fcntl.h> #include <sys/stat.h> #include <unistd.h> -]], [[int result = 0; +]GL_MDA_DEFINES], + [[int result = 0; const char *f = "conftest.file"; if (close (creat (f, 0600))) return 1; diff --git a/m4/utimes.m4 b/m4/utimes.m4 index e1056bbba4e..877bfd2a735 100644 --- a/m4/utimes.m4 +++ b/m4/utimes.m4 @@ -1,5 +1,5 @@ # Detect some bugs in glibc's implementation of utimes. -# serial 7 +# serial 8 dnl Copyright (C) 2003-2005, 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -34,6 +34,7 @@ AC_DEFUN([gl_FUNC_UTIMES], #include <stdio.h> #include <utime.h> #include <errno.h> +]GL_MDA_DEFINES[ static int inorder (time_t a, time_t b, time_t c) diff --git a/m4/warnings.m4 b/m4/warnings.m4 index d272365f0a1..d4e4b073453 100644 --- a/m4/warnings.m4 +++ b/m4/warnings.m4 @@ -1,4 +1,4 @@ -# warnings.m4 serial 14 +# warnings.m4 serial 16 dnl Copyright (C) 2008-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -23,8 +23,6 @@ m4_ifdef([AS_VAR_APPEND], # The effects of this macro depend on the current language (_AC_LANG). AC_DEFUN([gl_COMPILER_OPTION_IF], [ -dnl FIXME: gl_Warn must be used unquoted until we can assume Autoconf -dnl 2.64 or newer. AS_VAR_PUSHDEF([gl_Warn], [gl_cv_warn_[]_AC_LANG_ABBREV[]_$1])dnl AS_VAR_PUSHDEF([gl_Flags], [_AC_LANG_PREFIX[]FLAGS])dnl AS_LITERAL_IF([$1], @@ -34,13 +32,13 @@ case $gl_positive in -Wno-*) gl_positive=-W`expr "X$gl_positive" : 'X-Wno-\(.*\)'` ;; esac m4_pushdef([gl_Positive], [$gl_positive])])dnl -AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], m4_defn([gl_Warn]), [ +AC_CACHE_CHECK([whether _AC_LANG compiler handles $1], [gl_Warn], [ gl_save_compiler_FLAGS="$gl_Flags" gl_AS_VAR_APPEND(m4_defn([gl_Flags]), [" $gl_unknown_warnings_are_errors ]m4_defn([gl_Positive])["]) - AC_LINK_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([])])], - [AS_VAR_SET(gl_Warn, [yes])], - [AS_VAR_SET(gl_Warn, [no])]) + AC_LINK_IFELSE([m4_default([$4], [AC_LANG_PROGRAM([[]])])], + [AS_VAR_SET([gl_Warn], [yes])], + [AS_VAR_SET([gl_Warn], [no])]) gl_Flags="$gl_save_compiler_FLAGS" ]) AS_VAR_IF(gl_Warn, [yes], [$2], [$3]) @@ -59,8 +57,7 @@ AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS], [_AC_LANG_DISPATCH([$0], _AC_LANG, $@)]) # Specialization for _AC_LANG = C. This macro can be AC_REQUIREd. -# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b. -m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)], +AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)], [ AC_LANG_PUSH([C]) gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL @@ -68,8 +65,7 @@ m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)], ]) # Specialization for _AC_LANG = C++. This macro can be AC_REQUIREd. -# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b. -m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)], +AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)], [ AC_LANG_PUSH([C++]) gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL @@ -77,8 +73,7 @@ m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)], ]) # Specialization for _AC_LANG = Objective C. This macro can be AC_REQUIREd. -# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b. -m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(Objective C)], +AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(Objective C)], [ AC_LANG_PUSH([Objective C]) gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL diff --git a/nextstep/templates/Info.plist.in b/nextstep/templates/Info.plist.in index f791ade7b97..1f074b04578 100644 --- a/nextstep/templates/Info.plist.in +++ b/nextstep/templates/Info.plist.in @@ -675,8 +675,16 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. </array> <key>NSAppleScriptEnabled</key> <string>YES</string> - <key>NSAppleEventsUsageDescription</key> - <string>Emacs requires permission to send AppleEvents to other applications.</string> + <key>NSAppleEventsUsageDescription</key> + <string>Emacs requires permission to send AppleEvents to other applications.</string> + <!-- For xwidget webkit to browse remote url, + but this set no restriction at all. Consult apple's documentation + for detail information about `NSApplicationDefinedMask'. --> + <key>NSAppTransportSecurity</key> + <dict> + <key>NSAllowsArbitraryLoads</key> + <true/> + </dict> <key>NSDesktopFolderUsageDescription</key> <string>Emacs requires permission to access the Desktop folder.</string> <key>NSDocumentsFolderUsageDescription</key> diff --git a/src/Makefile.in b/src/Makefile.in index 7141f16ec25..c5fb2ea3ab2 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -433,6 +433,7 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \ fontset.o dbusbind.o cygw32.o \ nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o macfont.o \ + nsxwidget.o \ w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \ w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \ w16select.o widget.o xfont.o ftfont.o xftfont.o gtkutil.o \ diff --git a/src/bytecode.c b/src/bytecode.c index 1913a4812a0..1c3b6eac0d1 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1401,7 +1401,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1 = POP; ptrdiff_t i; struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table); - hash_rehash_if_needed (h); /* h->count is a faster approximation for HASH_TABLE_SIZE (h) here. */ diff --git a/src/ccl.c b/src/ccl.c index ef059ffff25..86debeef0e5 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -1142,19 +1142,52 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size ccl_expr_self: switch (op) { - case CCL_PLUS: reg[rrr] += i; break; - case CCL_MINUS: reg[rrr] -= i; break; - case CCL_MUL: reg[rrr] *= i; break; - case CCL_DIV: reg[rrr] /= i; break; + case CCL_PLUS: INT_ADD_WRAPV (reg[rrr], i, ®[rrr]); break; + case CCL_MINUS: INT_SUBTRACT_WRAPV (reg[rrr], i, ®[rrr]); break; + case CCL_MUL: INT_MULTIPLY_WRAPV (reg[rrr], i, ®[rrr]); break; + case CCL_DIV: + if (!i) + CCL_INVALID_CMD; + if (!INT_DIVIDE_OVERFLOW (reg[rrr], i)) + reg[rrr] /= i; + break; case CCL_MOD: reg[rrr] %= i; break; + if (!i) + CCL_INVALID_CMD; + reg[rrr] = i == -1 ? 0 : reg[rrr] % i; + break; case CCL_AND: reg[rrr] &= i; break; case CCL_OR: reg[rrr] |= i; break; case CCL_XOR: reg[rrr] ^= i; break; - case CCL_LSH: reg[rrr] <<= i; break; - case CCL_RSH: reg[rrr] >>= i; break; - case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break; + case CCL_LSH: + if (i < 0) + CCL_INVALID_CMD; + reg[rrr] = i < UINT_WIDTH ? (unsigned) reg[rrr] << i : 0; + break; + case CCL_RSH: + if (i < 0) + CCL_INVALID_CMD; + reg[rrr] = reg[rrr] >> min (i, INT_WIDTH - 1); + break; + case CCL_LSH8: + reg[rrr] = (unsigned) reg[rrr] << 8; + reg[rrr] |= i; + break; case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break; - case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break; + case CCL_DIVMOD: + if (!i) + CCL_INVALID_CMD; + if (i == -1) + { + reg[7] = 0; + INT_SUBTRACT_WRAPV (0, reg[rrr], ®[rrr]); + } + else + { + reg[7] = reg[rrr] % i; + reg[rrr] /= i; + } + break; case CCL_LS: reg[rrr] = reg[rrr] < i; break; case CCL_GT: reg[rrr] = reg[rrr] > i; break; case CCL_EQ: reg[rrr] = reg[rrr] == i; break; @@ -1204,19 +1237,52 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size ccl_set_expr: switch (op) { - case CCL_PLUS: reg[rrr] = i + j; break; - case CCL_MINUS: reg[rrr] = i - j; break; - case CCL_MUL: reg[rrr] = i * j; break; - case CCL_DIV: reg[rrr] = i / j; break; - case CCL_MOD: reg[rrr] = i % j; break; + case CCL_PLUS: INT_ADD_WRAPV (i, j, ®[rrr]); break; + case CCL_MINUS: INT_SUBTRACT_WRAPV (i, j, ®[rrr]); break; + case CCL_MUL: INT_MULTIPLY_WRAPV (i, j, ®[rrr]); break; + case CCL_DIV: + if (!j) + CCL_INVALID_CMD; + if (!INT_DIVIDE_OVERFLOW (i, j)) + i /= j; + reg[rrr] = i; + break; + case CCL_MOD: + if (!j) + CCL_INVALID_CMD; + reg[rrr] = j == -1 ? 0 : i % j; + break; case CCL_AND: reg[rrr] = i & j; break; case CCL_OR: reg[rrr] = i | j; break; case CCL_XOR: reg[rrr] = i ^ j; break; - case CCL_LSH: reg[rrr] = i << j; break; - case CCL_RSH: reg[rrr] = i >> j; break; - case CCL_LSH8: reg[rrr] = (i << 8) | j; break; + case CCL_LSH: + if (j < 0) + CCL_INVALID_CMD; + reg[rrr] = j < UINT_WIDTH ? (unsigned) i << j : 0; + break; + case CCL_RSH: + if (j < 0) + CCL_INVALID_CMD; + reg[rrr] = i >> min (j, INT_WIDTH - 1); + break; + case CCL_LSH8: + reg[rrr] = ((unsigned) i << 8) | j; + break; case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break; - case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break; + case CCL_DIVMOD: + if (!j) + CCL_INVALID_CMD; + if (j == -1) + { + INT_SUBTRACT_WRAPV (0, reg[rrr], ®[rrr]); + reg[7] = 0; + } + else + { + reg[rrr] = i / j; + reg[7] = i % j; + } + break; case CCL_LS: reg[rrr] = i < j; break; case CCL_GT: reg[rrr] = i > j; break; case CCL_EQ: reg[rrr] = i == j; break; @@ -1225,7 +1291,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size case CCL_NE: reg[rrr] = i != j; break; case CCL_DECODE_SJIS: { - i = (i << 8) | j; + i = ((unsigned) i << 8) | j; SJIS_TO_JIS (i); reg[rrr] = i >> 8; reg[7] = i & 0xFF; @@ -1233,7 +1299,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size } case CCL_ENCODE_SJIS: { - i = (i << 8) | j; + i = ((unsigned) i << 8) | j; JIS_TO_SJIS (i); reg[rrr] = i >> 8; reg[7] = i & 0xFF; @@ -2219,15 +2285,8 @@ Return index number of the registered CCL program. */) /* Extend the table. */ Vccl_program_table = larger_vector (Vccl_program_table, 1, -1); - { - Lisp_Object elt = make_uninit_vector (4); - - ASET (elt, 0, name); - ASET (elt, 1, ccl_prog); - ASET (elt, 2, resolved); - ASET (elt, 3, Qt); - ASET (Vccl_program_table, idx, elt); - } + ASET (Vccl_program_table, idx, + CALLN (Fvector, name, ccl_prog, resolved, Qt)); Fput (name, Qccl_program_idx, make_fixnum (idx)); return make_fixnum (idx); diff --git a/src/charset.c b/src/charset.c index 8635aad3ed6..520dd3a9605 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1035,12 +1035,9 @@ usage: (define-charset-internal ...) */) CHECK_FIXNAT (parent_max_code); parent_code_offset = Fnth (make_fixnum (3), val); CHECK_FIXNUM (parent_code_offset); - val = make_uninit_vector (4); - ASET (val, 0, make_fixnum (parent_charset->id)); - ASET (val, 1, parent_min_code); - ASET (val, 2, parent_max_code); - ASET (val, 3, parent_code_offset); - ASET (attrs, charset_subset, val); + ASET (attrs, charset_subset, + CALLN (Fvector, make_fixnum (parent_charset->id), + parent_min_code, parent_max_code, parent_code_offset)); charset.method = CHARSET_METHOD_SUBSET; /* Here, we just copy the parent's fast_map. It's not accurate, diff --git a/src/coding.c b/src/coding.c index 071124b4ef1..51bd441de9d 100644 --- a/src/coding.c +++ b/src/coding.c @@ -10856,20 +10856,17 @@ HIGHESTP non-nil means just return the highest priority one. */) return Fnreverse (val); } -static const char *const suffixes[] = { "-unix", "-dos", "-mac" }; - static Lisp_Object make_subsidiaries (Lisp_Object base) { - Lisp_Object subsidiaries; + static char const suffixes[][8] = { "-unix", "-dos", "-mac" }; ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base)); USE_SAFE_ALLOCA; char *buf = SAFE_ALLOCA (base_name_len + 6); - int i; memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len); - subsidiaries = make_uninit_vector (3); - for (i = 0; i < 3; i++) + Lisp_Object subsidiaries = make_nil_vector (3); + for (int i = 0; i < 3; i++) { strcpy (buf + base_name_len, suffixes[i]); ASET (subsidiaries, i, intern (buf)); @@ -11829,8 +11826,7 @@ Each element is one element list of coding system name. This variable is given to `completing-read' as COLLECTION argument. Do not alter the value of this variable manually. This variable should be -updated by the functions `make-coding-system' and -`define-coding-system-alias'. */); +updated by `define-coding-system-alias'. */); Vcoding_system_alist = Qnil; DEFVAR_LISP ("coding-category-list", Vcoding_category_list, diff --git a/src/composite.c b/src/composite.c index f96f0b77726..984e0d9cda8 100644 --- a/src/composite.c +++ b/src/composite.c @@ -652,7 +652,6 @@ Lisp_Object composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len) { struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); - hash_rehash_if_needed (h); Lisp_Object header = LGSTRING_HEADER (gstring); Lisp_Object hash = h->test.hashfn (header, h); if (len < 0) @@ -1259,7 +1258,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, is backward in the buffer, which can only happen if the display routines were called to perform the bidi reordering. But it doesn't harm to test for that, and - avoid someon raising their brows and thinking it's a + avoid someone raising their brows and thinking it's a subtle bug... */ if (bidi_level < 0) direction = Qnil; @@ -1940,7 +1939,7 @@ syms_of_composite (void) staticpro (&gstring_hash_table); staticpro (&gstring_work_headers); - gstring_work_headers = make_uninit_vector (8); + gstring_work_headers = make_nil_vector (8); for (i = 0; i < 8; i++) ASET (gstring_work_headers, i, make_nil_vector (i + 2)); staticpro (&gstring_work); diff --git a/src/emacs.c b/src/emacs.c index 8e5eaf5e43e..059e1c6d8f0 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1536,6 +1536,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!initialized) { init_alloc_once (); + init_pdumper_once (); init_obarray_once (); init_eval_once (); init_charset_once (); @@ -1624,23 +1625,27 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem { #ifdef NS_IMPL_COCOA /* Started from GUI? */ - /* FIXME: Do the right thing if get_homedir returns "", or if - chdir fails. */ - if (! inhibit_window_system && ! isatty (STDIN_FILENO) && ! ch_to_dir) - chdir (get_homedir ()); + bool go_home = (!ch_to_dir && !inhibit_window_system + && !isatty (STDIN_FILENO)); if (skip_args < argc) { if (!strncmp (argv[skip_args], "-psn", 4)) { skip_args += 1; - if (! ch_to_dir) chdir (get_homedir ()); + go_home |= !ch_to_dir; } else if (skip_args+1 < argc && !strncmp (argv[skip_args+1], "-psn", 4)) { skip_args += 2; - if (! ch_to_dir) chdir (get_homedir ()); + go_home |= !ch_to_dir; } } + if (go_home) + { + char const *home = get_homedir (); + if (*home && chdir (home) == 0) + emacs_wd = emacs_get_current_dir_name (); + } #endif /* COCOA */ } #endif /* HAVE_NS */ @@ -1859,7 +1864,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_xfns (); syms_of_xmenu (); syms_of_fontset (); - syms_of_xwidget (); syms_of_xsettings (); #ifdef HAVE_X_SM syms_of_xsmfns (); @@ -1936,6 +1940,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #endif /* HAVE_W32NOTIFY */ #endif /* WINDOWSNT */ + syms_of_xwidget (); syms_of_threads (); syms_of_profiler (); syms_of_pdumper (); diff --git a/src/fns.c b/src/fns.c index 811d6e82001..a3b8d6ef57d 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1747,25 +1747,27 @@ changing the value of a sequence `foo'. */) { if (VECTORP (seq)) { - ptrdiff_t i, n; + ptrdiff_t n = 0; + ptrdiff_t size = ASIZE (seq); + USE_SAFE_ALLOCA; + Lisp_Object *kept = SAFE_ALLOCA (size * sizeof *kept); - for (i = n = 0; i < ASIZE (seq); ++i) - if (NILP (Fequal (AREF (seq, i), elt))) - ++n; - - if (n != ASIZE (seq)) + for (ptrdiff_t i = 0; i < size; i++) { - struct Lisp_Vector *p = allocate_vector (n); + kept[n] = AREF (seq, i); + n += NILP (Fequal (AREF (seq, i), elt)); + } - for (i = n = 0; i < ASIZE (seq); ++i) - if (NILP (Fequal (AREF (seq, i), elt))) - p->contents[n++] = AREF (seq, i); + if (n != size) + seq = Fvector (n, kept); - XSETVECTOR (seq, p); - } + SAFE_FREE (); } else if (STRINGP (seq)) { + if (!CHARACTERP (elt)) + return seq; + ptrdiff_t i, ibyte, nchars, nbytes, cbytes; int c; @@ -1784,7 +1786,7 @@ changing the value of a sequence `foo'. */) cbytes = 1; } - if (!FIXNUMP (elt) || c != XFIXNUM (elt)) + if (c != XFIXNUM (elt)) { ++nchars; nbytes += cbytes; @@ -1814,7 +1816,7 @@ changing the value of a sequence `foo'. */) cbytes = 1; } - if (!FIXNUMP (elt) || c != XFIXNUM (elt)) + if (c != XFIXNUM (elt)) { unsigned char *from = SDATA (seq) + ibyte; unsigned char *to = SDATA (tem) + nbytes; @@ -4248,50 +4250,31 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) /* Recompute the hashes (and hence also the "next" pointers). Normally there's never a need to recompute hashes. - This is done only on first-access to a hash-table loaded from - the "pdump", because the object's addresses may have changed, thus - affecting their hash. */ + This is done only on first access to a hash-table loaded from + the "pdump", because the objects' addresses may have changed, thus + affecting their hashes. */ void -hash_table_rehash (struct Lisp_Hash_Table *h) +hash_table_rehash (Lisp_Object hash) { - ptrdiff_t size = HASH_TABLE_SIZE (h); - - /* These structures may have been purecopied and shared - (bug#36447). */ - Lisp_Object hash = make_nil_vector (size); - h->next = Fcopy_sequence (h->next); - h->index = Fcopy_sequence (h->index); + struct Lisp_Hash_Table *h = XHASH_TABLE (hash); + ptrdiff_t i, count = h->count; /* Recompute the actual hash codes for each entry in the table. Order is still invalid. */ - for (ptrdiff_t i = 0; i < size; ++i) + for (i = 0; i < count; i++) { Lisp_Object key = HASH_KEY (h, i); - if (!EQ (key, Qunbound)) - ASET (hash, i, h->test.hashfn (key, h)); + Lisp_Object hash_code = h->test.hashfn (key, h); + ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index); + set_hash_hash_slot (h, i, hash_code); + set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); + set_hash_index_slot (h, start_of_bucket, i); + eassert (HASH_NEXT (h, i) != i); /* Stop loops. */ } - /* Reset the index so that any slot we don't fill below is marked - invalid. */ - Ffillarray (h->index, make_fixnum (-1)); - - /* Rebuild the collision chains. */ - for (ptrdiff_t i = 0; i < size; ++i) - if (!NILP (AREF (hash, i))) - { - EMACS_UINT hash_code = XUFIXNUM (AREF (hash, i)); - ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index); - set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); - set_hash_index_slot (h, start_of_bucket, i); - eassert (HASH_NEXT (h, i) != i); /* Stop loops. */ - } - - /* Finally, mark the hash table as having a valid hash order. - Do this last so that if we're interrupted, we retry on next - access. */ - eassert (hash_rehash_needed_p (h)); - h->hash = hash; - eassert (!hash_rehash_needed_p (h)); + ptrdiff_t size = ASIZE (h->next); + for (; i + 1 < size; i++) + set_hash_next_slot (h, i, i + 1); } /* Lookup KEY in hash table H. If HASH is non-null, return in *HASH @@ -4303,8 +4286,6 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) { ptrdiff_t start_of_bucket, i; - hash_rehash_if_needed (h); - Lisp_Object hash_code = h->test.hashfn (key, h); if (hash) *hash = hash_code; @@ -4339,8 +4320,6 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, { ptrdiff_t start_of_bucket, i; - hash_rehash_if_needed (h); - /* Increment count after resizing because resizing may fail. */ maybe_resize_hash_table (h); h->count++; @@ -4373,8 +4352,6 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index); ptrdiff_t prev = -1; - hash_rehash_if_needed (h); - for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i)) @@ -4415,8 +4392,7 @@ hash_clear (struct Lisp_Hash_Table *h) if (h->count > 0) { ptrdiff_t size = HASH_TABLE_SIZE (h); - if (!hash_rehash_needed_p (h)) - memclear (xvector_contents (h->hash), size * word_size); + memclear (xvector_contents (h->hash), size * word_size); for (ptrdiff_t i = 0; i < size; i++) { set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); @@ -4452,9 +4428,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) for (ptrdiff_t bucket = 0; bucket < n; ++bucket) { /* Follow collision chain, removing entries that don't survive - this garbage collection. It's okay if hash_rehash_needed_p - (h) is true, since we're operating entirely on the cached - hash values. */ + this garbage collection. */ ptrdiff_t prev = -1; ptrdiff_t next; for (ptrdiff_t i = HASH_INDEX (h, bucket); 0 <= i; i = next) @@ -4499,7 +4473,7 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) set_hash_hash_slot (h, i, Qnil); eassert (h->count != 0); - h->count += h->count > 0 ? -1 : 1; + h->count--; } else { @@ -4923,7 +4897,6 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, (Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - eassert (h->count >= 0); return make_fixnum (h->count); } diff --git a/src/font.c b/src/font.c index ab00402b40b..5c01c7ff796 100644 --- a/src/font.c +++ b/src/font.c @@ -4847,21 +4847,18 @@ If the font is not OpenType font, CAPABILITY is nil. */) (Lisp_Object font_object) { struct font *font = CHECK_FONT_GET_OBJECT (font_object); - Lisp_Object val = make_uninit_vector (9); - - ASET (val, 0, AREF (font_object, FONT_NAME_INDEX)); - ASET (val, 1, AREF (font_object, FONT_FILE_INDEX)); - ASET (val, 2, make_fixnum (font->pixel_size)); - ASET (val, 3, make_fixnum (font->max_width)); - ASET (val, 4, make_fixnum (font->ascent)); - ASET (val, 5, make_fixnum (font->descent)); - ASET (val, 6, make_fixnum (font->space_width)); - ASET (val, 7, make_fixnum (font->average_width)); - if (font->driver->otf_capability) - ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font))); - else - ASET (val, 8, Qnil); - return val; + return CALLN (Fvector, + AREF (font_object, FONT_NAME_INDEX), + AREF (font_object, FONT_FILE_INDEX), + make_fixnum (font->pixel_size), + make_fixnum (font->max_width), + make_fixnum (font->ascent), + make_fixnum (font->descent), + make_fixnum (font->space_width), + make_fixnum (font->average_width), + (font->driver->otf_capability + ? Fcons (Qopentype, font->driver->otf_capability (font)) + : Qnil)); } DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0, @@ -4889,7 +4886,7 @@ the corresponding element is nil. */) { struct font *font = CHECK_FONT_GET_OBJECT (font_object); ptrdiff_t len; - Lisp_Object *chars, vec; + Lisp_Object *chars; USE_SAFE_ALLOCA; if (NILP (object)) @@ -4957,7 +4954,7 @@ the corresponding element is nil. */) else wrong_type_argument (Qarrayp, object); - vec = make_uninit_vector (len); + Lisp_Object vec = make_nil_vector (len); for (ptrdiff_t i = 0; i < len; i++) { Lisp_Object g; @@ -5168,24 +5165,23 @@ If the named font cannot be opened and loaded, return nil. */) return Qnil; font = XFONT_OBJECT (font_object); - info = make_uninit_vector (14); - ASET (info, 0, AREF (font_object, FONT_NAME_INDEX)); - ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX)); - ASET (info, 2, make_fixnum (font->pixel_size)); - ASET (info, 3, make_fixnum (font->height)); - ASET (info, 4, make_fixnum (font->baseline_offset)); - ASET (info, 5, make_fixnum (font->relative_compose)); - ASET (info, 6, make_fixnum (font->default_ascent)); - ASET (info, 7, make_fixnum (font->max_width)); - ASET (info, 8, make_fixnum (font->ascent)); - ASET (info, 9, make_fixnum (font->descent)); - ASET (info, 10, make_fixnum (font->space_width)); - ASET (info, 11, make_fixnum (font->average_width)); - ASET (info, 12, AREF (font_object, FONT_FILE_INDEX)); - if (font->driver->otf_capability) - ASET (info, 13, Fcons (Qopentype, font->driver->otf_capability (font))); - else - ASET (info, 13, Qnil); + info = CALLN (Fvector, + AREF (font_object, FONT_NAME_INDEX), + AREF (font_object, FONT_FULLNAME_INDEX), + make_fixnum (font->pixel_size), + make_fixnum (font->height), + make_fixnum (font->baseline_offset), + make_fixnum (font->relative_compose), + make_fixnum (font->default_ascent), + make_fixnum (font->max_width), + make_fixnum (font->ascent), + make_fixnum (font->descent), + make_fixnum (font->space_width), + make_fixnum (font->average_width), + AREF (font_object, FONT_FILE_INDEX), + (font->driver->otf_capability + ? Fcons (Qopentype, font->driver->otf_capability (font)) + : Qnil)); #if 0 /* As font_object is still in FONT_OBJLIST of the entity, we can't @@ -5203,7 +5199,7 @@ If the named font cannot be opened and loaded, return nil. */) static Lisp_Object build_style_table (const struct table_entry *entry, int nelement) { - Lisp_Object table = make_uninit_vector (nelement); + Lisp_Object table = make_nil_vector (nelement); for (int i = 0; i < nelement; i++) { int j; @@ -5494,10 +5490,8 @@ This variable cannot be set; trying to do so will signal an error. */); make_symbol_constant (intern_c_string ("font-width-table")); staticpro (&font_style_table); - font_style_table = make_uninit_vector (3); - ASET (font_style_table, 0, Vfont_weight_table); - ASET (font_style_table, 1, Vfont_slant_table); - ASET (font_style_table, 2, Vfont_width_table); + font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table, + Vfont_width_table); DEFVAR_LISP ("font-log", Vfont_log, doc: /* A list that logs font-related actions and results, for debugging. diff --git a/src/fontset.c b/src/fontset.c index c2bb8b21f26..8c86075c07e 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -252,14 +252,13 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback) #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset))) -/* Macros for FONT-DEF and RFONT-DEF of fontset. */ -#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \ - do { \ - (font_def) = make_uninit_vector (3); \ - ASET ((font_def), 0, font_spec); \ - ASET ((font_def), 1, encoding); \ - ASET ((font_def), 2, repertory); \ - } while (0) +/* Definitions for FONT-DEF and RFONT-DEF of fontset. */ +static Lisp_Object +font_def_new (Lisp_Object font_spec, Lisp_Object encoding, + Lisp_Object repertory) +{ + return CALLN (Fvector, font_spec, encoding, repertory); +} #define FONT_DEF_SPEC(font_def) AREF (font_def, 0) #define FONT_DEF_ENCODING(font_def) AREF (font_def, 1) @@ -1547,7 +1546,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) repertory = CHARSET_SYMBOL_ID (repertory); } } - FONT_DEF_NEW (font_def, font_spec, encoding, repertory); + font_def = font_def_new (font_spec, encoding, repertory); } else font_def = Qnil; @@ -1619,14 +1618,8 @@ appended. By default, FONT-SPEC overrides the previous settings. */) if (charset) { - Lisp_Object arg; - - arg = make_uninit_vector (5); - ASET (arg, 0, fontset); - ASET (arg, 1, font_def); - ASET (arg, 2, add); - ASET (arg, 3, ascii_changed ? Qt : Qnil); - ASET (arg, 4, range_list); + Lisp_Object arg = CALLN (Fvector, fontset, font_def, add, + ascii_changed ? Qt : Qnil, range_list); map_charset_chars (set_fontset_font, Qnil, arg, charset, CHARSET_MIN_CODE (charset), diff --git a/src/frame.c b/src/frame.c index c21d4708f75..c4dfc35a0c5 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2565,21 +2565,18 @@ before calling this function on it, like this. if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ frame_set_mouse_position (XFRAME (frame), xval, yval); -#else -#if defined (MSDOS) +#elif defined MSDOS if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); mouse_moveto (xval, yval); } +#elif defined HAVE_GPM + Fselect_frame (frame, Qnil); + term_mouse_moveto (xval, yval); #else -#ifdef HAVE_GPM - { - Fselect_frame (frame, Qnil); - term_mouse_moveto (xval, yval); - } -#endif -#endif + (void) xval; + (void) yval; #endif return Qnil; @@ -2606,21 +2603,18 @@ before calling this function on it, like this. if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ frame_set_mouse_pixel_position (XFRAME (frame), xval, yval); -#else -#if defined (MSDOS) +#elif defined MSDOS if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); mouse_moveto (xval, yval); } +#elif defined HAVE_GPM + Fselect_frame (frame, Qnil); + term_mouse_moveto (xval, yval); #else -#ifdef HAVE_GPM - { - Fselect_frame (frame, Qnil); - term_mouse_moveto (xval, yval); - } -#endif -#endif + (void) xval; + (void) yval; #endif return Qnil; @@ -3657,6 +3651,9 @@ bottom edge of FRAME's display. */) #ifdef HAVE_WINDOW_SYSTEM if (FRAME_TERMINAL (f)->set_frame_offset_hook) FRAME_TERMINAL (f)->set_frame_offset_hook (f, xval, yval, 1); +#else + (void) xval; + (void) yval; #endif } diff --git a/src/ftfont.c b/src/ftfont.c index 696f5e65341..a904007a329 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -2826,14 +2826,10 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, LGLYPH_SET_ASCENT (lglyph, g->g.ascent >> 6); LGLYPH_SET_DESCENT (lglyph, g->g.descent >> 6); if (g->g.adjusted) - { - Lisp_Object vec = make_uninit_vector (3); - - ASET (vec, 0, make_fixnum (g->g.xoff >> 6)); - ASET (vec, 1, make_fixnum (g->g.yoff >> 6)); - ASET (vec, 2, make_fixnum (g->g.xadv >> 6)); - LGLYPH_SET_ADJUSTMENT (lglyph, vec); - } + LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector, + make_fixnum (g->g.xoff >> 6), + make_fixnum (g->g.yoff >> 6), + make_fixnum (g->g.xadv >> 6))); } return make_fixnum (i); } diff --git a/src/hbfont.c b/src/hbfont.c index 4b3f64ef504..82b115e6868 100644 --- a/src/hbfont.c +++ b/src/hbfont.c @@ -594,13 +594,10 @@ hbfont_shape (Lisp_Object lgstring, Lisp_Object direction) yoff = - lround (pos[i].y_offset * position_unit); wadjust = lround (pos[i].x_advance * position_unit); if (xoff || yoff || wadjust != metrics.width) - { - Lisp_Object vec = make_uninit_vector (3); - ASET (vec, 0, make_fixnum (xoff)); - ASET (vec, 1, make_fixnum (yoff)); - ASET (vec, 2, make_fixnum (wadjust)); - LGLYPH_SET_ADJUSTMENT (lglyph, vec); - } + LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector, + make_fixnum (xoff), + make_fixnum (yoff), + make_fixnum (wadjust))); } return make_fixnum (glyph_len); diff --git a/src/image.c b/src/image.c index e236b389210..643b3d0a1f4 100644 --- a/src/image.c +++ b/src/image.c @@ -803,17 +803,23 @@ valid_image_p (Lisp_Object object) { Lisp_Object tail = XCDR (object); FOR_EACH_TAIL_SAFE (tail) - if (EQ (XCAR (tail), QCtype)) - { - tail = XCDR (tail); - if (CONSP (tail)) - { - struct image_type const *type = lookup_image_type (XCAR (tail)); - if (type) - return type->valid_p (object); - } - break; - } + { + if (EQ (XCAR (tail), QCtype)) + { + tail = XCDR (tail); + if (CONSP (tail)) + { + struct image_type const *type = + lookup_image_type (XCAR (tail)); + if (type) + return type->valid_p (object); + } + break; + } + tail = XCDR (tail); + if (! CONSP (tail)) + return false; + } } return false; @@ -899,7 +905,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, return false; plist = XCDR (spec); - while (CONSP (plist)) + FOR_EACH_TAIL_SAFE (plist) { Lisp_Object key, value; @@ -913,7 +919,6 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, if (!CONSP (plist)) return false; value = XCAR (plist); - plist = XCDR (plist); /* Find key in KEYWORDS. Error if not found. */ for (i = 0; i < nkeywords; ++i) @@ -921,7 +926,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, break; if (i == nkeywords) - continue; + goto maybe_done; /* Record that we recognized the keyword. If a keyword was found more than once, it's an error. */ @@ -1009,14 +1014,20 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, if (EQ (key, QCtype) && !(EQ (type, value) || EQ (type, Qnative_image))) return false; - } - /* Check that all mandatory fields are present. */ - for (i = 0; i < nkeywords; ++i) - if (keywords[i].count < keywords[i].mandatory_p) - return false; + maybe_done: + if (EQ (XCDR (plist), Qnil)) + { + /* Check that all mandatory fields are present. */ + for (i = 0; i < nkeywords; ++i) + if (keywords[i].mandatory_p && keywords[i].count == 0) + return false; + + return true; + } + } - return NILP (plist); + return false; } @@ -1031,9 +1042,8 @@ image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found) eassert (valid_image_p (spec)); - for (tail = XCDR (spec); - CONSP (tail) && CONSP (XCDR (tail)); - tail = XCDR (XCDR (tail))) + tail = XCDR (spec); + FOR_EACH_TAIL_SAFE (tail) { if (EQ (XCAR (tail), key)) { @@ -1041,6 +1051,9 @@ image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found) *found = 1; return XCAR (XCDR (tail)); } + tail = XCDR (tail); + if (! CONSP (tail)) + break; } if (found) @@ -1584,6 +1597,16 @@ make_image_cache (void) return c; } +/* Compare two lists (one of which must be proper), comparing each + element with `eq'. */ +static bool +equal_lists (Lisp_Object a, Lisp_Object b) +{ + while (CONSP (a) && CONSP (b) && EQ (XCAR (a), XCAR (b))) + a = XCDR (a), b = XCDR (b); + + return EQ (a, b); +} /* Find an image matching SPEC in the cache, and return it. If no image is found, return NULL. */ @@ -1610,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 - && !NILP (Fequal (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/json.c b/src/json.c index 814afc6d741..8c9583631ad 100644 --- a/src/json.c +++ b/src/json.c @@ -479,9 +479,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration *conf) { intmax_t low = TYPE_MINIMUM (json_int_t); intmax_t high = TYPE_MAXIMUM (json_int_t); - intmax_t value; - if (! (integer_to_intmax (lisp, &value) && low <= value && value <= high)) - args_out_of_range_3 (lisp, make_int (low), make_int (high)); + intmax_t value = check_integer_range (lisp, low, high); return json_check (json_integer (value)); } else if (FLOATP (lisp)) diff --git a/src/lisp.h b/src/lisp.h index 17b92a04146..7983339ac50 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1809,7 +1809,8 @@ bool_vector_uchar_data (Lisp_Object a) INLINE bool bool_vector_bitref (Lisp_Object a, EMACS_INT i) { - eassume (0 <= i && i < bool_vector_size (a)); + eassume (0 <= i); + eassert (i < bool_vector_size (a)); return !! (bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR] & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))); } @@ -1825,11 +1826,11 @@ bool_vector_ref (Lisp_Object a, EMACS_INT i) INLINE void bool_vector_set (Lisp_Object a, EMACS_INT i, bool b) { - unsigned char *addr; - - eassume (0 <= i && i < bool_vector_size (a)); - addr = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR]; + eassume (0 <= i); + eassert (i < bool_vector_size (a)); + unsigned char *addr + = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR]; if (b) *addr |= 1 << (i % BOOL_VECTOR_BITS_PER_CHAR); else @@ -2275,11 +2276,7 @@ struct hash_table_test struct Lisp_Hash_Table { - /* Change pdumper.c if you change the fields here. - - IMPORTANT!!!!!!! - - Call hash_rehash_if_needed() before accessing. */ + /* Change pdumper.c if you change the fields here. */ /* This is for Lisp; the hash table code does not refer to it. */ union vectorlike_header header; @@ -2398,20 +2395,7 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) return size; } -void hash_table_rehash (struct Lisp_Hash_Table *h); - -INLINE bool -hash_rehash_needed_p (const struct Lisp_Hash_Table *h) -{ - return NILP (h->hash); -} - -INLINE void -hash_rehash_if_needed (struct Lisp_Hash_Table *h) -{ - if (hash_rehash_needed_p (h)) - hash_table_rehash (h); -} +void hash_table_rehash (Lisp_Object); /* Default size for hash tables if not specified. */ @@ -3932,7 +3916,6 @@ build_string (const char *str) extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); -extern struct Lisp_Vector *allocate_vector (ptrdiff_t); extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); /* Make an uninitialized vector for SIZE objects. NOTE: you must @@ -3942,7 +3925,11 @@ extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); v = make_uninit_vector (3); ASET (v, 0, obj0); ASET (v, 1, Ffunction_can_gc ()); - ASET (v, 2, obj1); */ + ASET (v, 2, obj1); + + allocate_vector has a similar problem. */ + +extern struct Lisp_Vector *allocate_vector (ptrdiff_t); INLINE Lisp_Object make_uninit_vector (ptrdiff_t size) @@ -3964,7 +3951,8 @@ make_uninit_sub_char_table (int depth, int min_char) return v; } -/* Make a vector of SIZE nils. */ +/* Make a vector of SIZE nils - faster than make_vector (size, Qnil) + if the OS already cleared the new memory. */ INLINE Lisp_Object make_nil_vector (ptrdiff_t size) diff --git a/src/macfont.m b/src/macfont.m index 21bc7dde5b3..904814647f9 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -1120,7 +1120,10 @@ struct macfont_metrics glyph width. The `width_int' member is an integer that is closest to the width. The `width_frac' member is the fractional adjustment representing a value in [-.5, .5], multiplied by - WIDTH_FRAC_SCALE. For synthetic monospace fonts, they represent + WIDTH_FRAC_SCALE. For monospace fonts, non-zero `width_frac' + means `width_int' is further adjusted to a multiple of the + (rounded) font width, and `width_frac' represents adjustment per + unit character. For synthetic monospace fonts, they represent the advance delta for centering instead of the glyph width. */ signed width_frac : WIDTH_FRAC_BITS, width_int : 16 - WIDTH_FRAC_BITS; }; @@ -1148,6 +1151,27 @@ enum metrics_status #define LCD_FONT_SMOOTHING_LEFT_MARGIN (0.396f) #define LCD_FONT_SMOOTHING_RIGHT_MARGIN (0.396f) +/* If FONT is monospace and WIDTH can be regarded as a multiple of its + width where the multiplier is greater than 1, then return the + multiplier. Otherwise return 0. */ +static int +macfont_monospace_width_multiplier (struct font *font, CGFloat width) +{ + struct macfont_info *macfont_info = (struct macfont_info *) font; + int multiplier = 0; + + if (macfont_info->spacing == MACFONT_SPACING_MONO + && font->space_width != 0) + { + multiplier = lround (width / font->space_width); + if (multiplier == 1 + || lround (width / multiplier) != font->space_width) + multiplier = 0; + } + + return multiplier; +} + static int macfont_glyph_extents (struct font *font, CGGlyph glyph, struct font_metrics *metrics, CGFloat *advance_delta, @@ -1192,13 +1216,38 @@ macfont_glyph_extents (struct font *font, CGGlyph glyph, else fwidth = mac_font_get_advance_width_for_glyph (macfont, glyph); - /* For synthetic mono fonts, cache->width_{int,frac} holds the - advance delta value. */ - if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO) - fwidth = (font->pixel_size - fwidth) / 2; - cache->width_int = lround (fwidth); - cache->width_frac = lround ((fwidth - cache->width_int) - * WIDTH_FRAC_SCALE); + if (macfont_info->spacing == MACFONT_SPACING_MONO) + { + /* Some monospace fonts for programming languages contain + wider ligature glyphs consisting of multiple characters. + For such glyphs, simply rounding the combined fractional + width to an integer can result in a value that is not a + multiple of the (rounded) font width. */ + int multiplier = macfont_monospace_width_multiplier (font, fwidth); + + if (multiplier) + { + cache->width_int = font->space_width * multiplier; + cache->width_frac = lround ((fwidth / multiplier + - font->space_width) + * WIDTH_FRAC_SCALE); + } + else + { + cache->width_int = lround (fwidth); + cache->width_frac = 0; + } + } + else + { + /* For synthetic mono fonts, cache->width_{int,frac} holds + the advance delta value. */ + if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO) + fwidth = (font->pixel_size - fwidth) / 2; + cache->width_int = lround (fwidth); + cache->width_frac = lround ((fwidth - cache->width_int) + * WIDTH_FRAC_SCALE); + } METRICS_SET_STATUS (cache, METRICS_WIDTH_VALID); } if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO) @@ -1235,6 +1284,10 @@ macfont_glyph_extents (struct font *font, CGGlyph glyph, / (CGFloat) (WIDTH_FRAC_SCALE * 2)); break; case MACFONT_SPACING_MONO: + if (cache->width_frac) + bounds.origin.x += - ((cache->width_frac + / (CGFloat) (WIDTH_FRAC_SCALE * 2)) + * (cache->width_int / font->space_width)); break; case MACFONT_SPACING_SYNTHETIC_MONO: bounds.origin.x += (cache->width_int @@ -1271,7 +1324,16 @@ macfont_glyph_extents (struct font *font, CGGlyph glyph, / (CGFloat) (WIDTH_FRAC_SCALE * 2))); break; case MACFONT_SPACING_MONO: - *advance_delta = 0; + if (cache->width_frac) + *advance_delta = 0; + else + { + CGFloat delta = - ((cache->width_frac + / (CGFloat) (WIDTH_FRAC_SCALE * 2)) + * (cache->width_int / font->space_width)); + + *advance_delta = (force_integral_p ? round (delta) : delta); + } break; case MACFONT_SPACING_SYNTHETIC_MONO: *advance_delta = (force_integral_p ? cache->width_int @@ -3015,7 +3077,7 @@ macfont_shape (Lisp_Object lgstring, Lisp_Object direction) struct mac_glyph_layout *gl = glyph_layouts + i; EMACS_INT from, to; struct font_metrics metrics; - int xoff, yoff, wadjust; + int xoff, yoff, wadjust, multiplier; if (NILP (lglyph)) { @@ -3068,13 +3130,15 @@ macfont_shape (Lisp_Object lgstring, Lisp_Object direction) xoff = lround (gl->advance_delta); yoff = lround (- gl->baseline_delta); - wadjust = lround (gl->advance); + multiplier = macfont_monospace_width_multiplier (font, gl->advance); + if (multiplier) + wadjust = font->space_width * multiplier; + else + wadjust = lround (gl->advance); if (xoff != 0 || yoff != 0 || wadjust != metrics.width) { - Lisp_Object vec = make_uninit_vector (3); - ASET (vec, 0, make_fixnum (xoff)); - ASET (vec, 1, make_fixnum (yoff)); - ASET (vec, 2, make_fixnum (wadjust)); + Lisp_Object vec = CALLN (Fvector, make_fixnum (xoff), + make_fixnum (yoff), make_fixnum (wadjust)); LGLYPH_SET_ADJUSTMENT (lglyph, vec); } } diff --git a/src/minibuf.c b/src/minibuf.c index 9d870ce3640..e18ff17abbf 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -251,7 +251,7 @@ read_minibuf_noninteractive (Lisp_Object prompt, bool expflag, else { xfree (line); - error ("Error reading from stdin"); + xsignal1 (Qend_of_file, build_string ("Error reading from stdin")); } /* If Lisp form desired instead of string, parse it. */ @@ -1212,9 +1212,6 @@ is used to further constrain the set of candidates. */) bucket = AREF (collection, idx); } - if (HASH_TABLE_P (collection)) - hash_rehash_if_needed (XHASH_TABLE (collection)); - while (1) { /* Get the next element of the alist, obarray, or hash-table. */ diff --git a/src/nsselect.m b/src/nsselect.m index 38ac66e9c7b..7b1937f5d99 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -114,7 +114,7 @@ clean_local_selection_data (Lisp_Object obj) if (size == 1) return clean_local_selection_data (AREF (obj, 0)); - copy = make_uninit_vector (size); + copy = make_nil_vector (size); for (i = 0; i < size; i++) ASET (copy, i, clean_local_selection_data (AREF (obj, i))); return copy; diff --git a/src/nsterm.m b/src/nsterm.m index 572b859a982..98c5b69d681 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -49,6 +49,7 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #include "nsterm.h" #include "systime.h" #include "character.h" +#include "xwidget.h" #include "fontset.h" #include "composite.h" #include "ccl.h" @@ -2600,7 +2601,8 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) } static int -ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y) +ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y, + BOOL dragging) /* ------------------------------------------------------------------------ Called by EmacsView on mouseMovement events. Passes on to emacs mainstream code if we moved off of a rect of interest @@ -2609,17 +2611,24 @@ ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y) { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame); NSRect *r; + BOOL force_update = NO; // NSTRACE ("note_mouse_movement"); dpyinfo->last_mouse_motion_frame = frame; r = &dpyinfo->last_mouse_glyph; + /* If the last rect is too large (ex, xwidget webkit), update at + every move, or resizing by dragging modeline or vertical split is + very hard to make its way. */ + if (dragging && (r->size.width > 32 || r->size.height > 32)) + force_update = YES; + /* Note, this doesn't get called for enter/leave, since we don't have a position. Those are taken care of in the corresponding NSView methods. */ /* Has movement gone beyond last rect we were tracking? */ - if (x < r->origin.x || x >= r->origin.x + r->size.width + if (force_update || x < r->origin.x || x >= r->origin.x + r->size.width || y < r->origin.y || y >= r->origin.y + r->size.height) { ns_update_begin (frame); @@ -4368,6 +4377,10 @@ ns_draw_glyph_string (struct glyph_string *s) ns_unfocus (s->f); break; + case XWIDGET_GLYPH: + x_draw_xwidget_glyph_string (s); + break; + case STRETCH_GLYPH: ns_dumpglyphs_stretch (s); break; @@ -7065,6 +7078,7 @@ not_in_argv (NSString *arg) struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); Lisp_Object frame; NSPoint pt; + BOOL dragging; NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "[EmacsView mouseMoved:]"); @@ -7107,7 +7121,8 @@ not_in_argv (NSString *arg) last_mouse_window = window; } - if (!ns_note_mouse_movement (emacsframe, pt.x, pt.y)) + dragging = (e.type == NSEventTypeLeftMouseDragged); + if (!ns_note_mouse_movement (emacsframe, pt.x, pt.y, dragging)) help_echo_string = previous_help_echo_string; XSETFRAME (frame, emacsframe); @@ -7654,11 +7669,8 @@ not_in_argv (NSString *arg) /* macOS Sierra automatically enables tabbed windows. We can't allow this to be enabled until it's available on a Free system. Currently it only happens by accident and is buggy anyway. */ -#if defined (NS_IMPL_COCOA) \ - && MAC_OS_X_VERSION_MAX_ALLOWED >= 101200 -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101200 +#ifdef NS_IMPL_COCOA if ([win respondsToSelector: @selector(setTabbingMode:)]) -#endif [win setTabbingMode: NSWindowTabbingModeDisallowed]; #endif @@ -8409,25 +8421,17 @@ not_in_argv (NSString *arg) - (void)windowDidChangeBackingProperties:(NSNotification *)notification - /* Update the drawing buffer when the backing scale factor changes. */ + /* Update the drawing buffer when the backing properties change. */ { NSTRACE ("EmacsView windowDidChangeBackingProperties:]"); if (! [self wantsUpdateLayer]) return; - CGFloat old = [[[notification userInfo] - objectForKey:@"NSBackingPropertyOldScaleFactorKey"] - doubleValue]; - CGFloat new = [[self window] backingScaleFactor]; - - if (old != new) - { - NSRect frame = [self frame]; - [self createDrawingBuffer]; - ns_clear_frame (emacsframe); - expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame)); - } + NSRect frame = [self frame]; + [self createDrawingBuffer]; + ns_clear_frame (emacsframe); + expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame)); } #endif /* NS_DRAW_TO_BUFFER */ diff --git a/src/nsxwidget.h b/src/nsxwidget.h new file mode 100644 index 00000000000..3d91594c341 --- /dev/null +++ b/src/nsxwidget.h @@ -0,0 +1,80 @@ +/* Header for NS Cocoa part of xwidget and webkit widget. + +Copyright (C) 2019-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 <http://www.gnu.org/licenses/>. */ + +#ifndef NSXWIDGET_H_INCLUDED +#define NSXWIDGET_H_INCLUDED + +/* This file can be included from non-objc files through 'xwidget.h'. */ +#ifdef __OBJC__ +#import <AppKit/NSView.h> +#endif + +#include "dispextern.h" +#include "lisp.h" +#include "xwidget.h" + +/* Functions for xwidget webkit. */ + +bool nsxwidget_is_web_view (struct xwidget *xw); +Lisp_Object nsxwidget_webkit_uri (struct xwidget *xw); +Lisp_Object nsxwidget_webkit_title (struct xwidget *xw); +void nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri); +void nsxwidget_webkit_goto_history (struct xwidget *xw, int rel_pos); +void nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change); +void nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script, + Lisp_Object fun); + +/* Functions for xwidget model. */ + +#ifdef __OBJC__ +@interface XwWindow : NSView +@property struct xwidget *xw; +@end +#endif + +void nsxwidget_init (struct xwidget *xw); +void nsxwidget_kill (struct xwidget *xw); +void nsxwidget_resize (struct xwidget *xw); +Lisp_Object nsxwidget_get_size (struct xwidget *xw); + +/* Functions for xwidget view. */ + +#ifdef __OBJC__ +@interface XvWindow : NSView +@property struct xwidget *xw; +@property struct xwidget_view *xv; +@end +#endif + +void nsxwidget_init_view (struct xwidget_view *xv, + struct xwidget *xww, + struct glyph_string *s, + int x, int y); +void nsxwidget_delete_view (struct xwidget_view *xv); + +void nsxwidget_show_view (struct xwidget_view *xv); +void nsxwidget_hide_view (struct xwidget_view *xv); +void nsxwidget_resize_view (struct xwidget_view *xv, + int widget, int height); + +void nsxwidget_move_view (struct xwidget_view *xv, int x, int y); +void nsxwidget_move_widget_in_view (struct xwidget_view *xv, int x, int y); +void nsxwidget_set_needsdisplay (struct xwidget_view *xv); + +#endif /* NSXWIDGET_H_INCLUDED */ diff --git a/src/nsxwidget.m b/src/nsxwidget.m new file mode 100644 index 00000000000..e81ca7fc0cb --- /dev/null +++ b/src/nsxwidget.m @@ -0,0 +1,601 @@ +/* NS Cocoa part implementation of xwidget and webkit widget. + +Copyright (C) 2019-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 <http://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include "lisp.h" +#include "blockinput.h" +#include "dispextern.h" +#include "buffer.h" +#include "frame.h" +#include "nsterm.h" +#include "xwidget.h" + +#import <AppKit/AppKit.h> +#import <WebKit/WebKit.h> + +/* Thoughts on NS Cocoa xwidget and webkit2: + + Webkit2 process architecture seems to be very hostile for offscreen + rendering techniques, which is used by GTK xwiget implementation; + Specifically NSView level view sharing / copying is not working. + + *** So only one view can be associcated with a model. *** + + With this decision, implementation is plain and can expect best out + of webkit2's rationale. But process and session structures will + diverge from GTK xwiget. Though, cosmetically similar usages can + be presented and will be preferred, if agreeable. + + For other widget types, OSR seems possible, but will not care for a + while. */ + +/* Xwidget webkit. */ + +@interface XwWebView : WKWebView +<WKNavigationDelegate, WKUIDelegate, WKScriptMessageHandler> +@property struct xwidget *xw; +/* Map url to whether javascript is blocked by + 'Content-Security-Policy' sandbox without allow-scripts. */ +@property(retain) NSMutableDictionary *urlScriptBlocked; +@end +@implementation XwWebView : WKWebView + +- (id)initWithFrame:(CGRect)frame + configuration:(WKWebViewConfiguration *)configuration + xwidget:(struct xwidget *)xw +{ + /* Script controller to add script message handler and user script. */ + WKUserContentController *scriptor = [[WKUserContentController alloc] init]; + configuration.userContentController = scriptor; + + /* Enable inspect element context menu item for debugging. */ + [configuration.preferences setValue:@YES + forKey:@"developerExtrasEnabled"]; + + Lisp_Object enablePlugins = + Fintern (build_string ("xwidget-webkit-enable-plugins"), Qnil); + if (!EQ (Fsymbol_value (enablePlugins), Qnil)) + configuration.preferences.plugInsEnabled = YES; + + self = [super initWithFrame:frame configuration:configuration]; + if (self) + { + self.xw = xw; + self.urlScriptBlocked = [[NSMutableDictionary alloc] init]; + self.navigationDelegate = self; + self.UIDelegate = self; + self.customUserAgent = + @"Mozilla/5.0 (Macintosh; Intel Mac OS X 10_12_6)" + @" AppleWebKit/603.3.8 (KHTML, like Gecko)" + @" Version/11.0.1 Safari/603.3.8"; + [scriptor addScriptMessageHandler:self name:@"keyDown"]; + [scriptor addUserScript:[[WKUserScript alloc] + initWithSource:xwScript + injectionTime: + WKUserScriptInjectionTimeAtDocumentStart + forMainFrameOnly:NO]]; + } + return self; +} + +- (void)webView:(WKWebView *)webView +didFinishNavigation:(WKNavigation *)navigation +{ + if (EQ (Fbuffer_live_p (self.xw->buffer), Qt)) + store_xwidget_event_string (self.xw, "load-changed", ""); +} + +- (void)webView:(WKWebView *)webView +decidePolicyForNavigationAction:(WKNavigationAction *)navigationAction +decisionHandler:(void (^)(WKNavigationActionPolicy))decisionHandler +{ + switch (navigationAction.navigationType) { + case WKNavigationTypeLinkActivated: + decisionHandler (WKNavigationActionPolicyAllow); + break; + default: + // decisionHandler (WKNavigationActionPolicyCancel); + decisionHandler (WKNavigationActionPolicyAllow); + break; + } +} + +- (void)webView:(WKWebView *)webView +decidePolicyForNavigationResponse:(WKNavigationResponse *)navigationResponse +decisionHandler:(void (^)(WKNavigationResponsePolicy))decisionHandler +{ + if (!navigationResponse.canShowMIMEType) + { + NSString *url = navigationResponse.response.URL.absoluteString; + NSString *mimetype = navigationResponse.response.MIMEType; + NSString *filename = navigationResponse.response.suggestedFilename; + decisionHandler (WKNavigationResponsePolicyCancel); + store_xwidget_download_callback_event (self.xw, + url.UTF8String, + mimetype.UTF8String, + filename.UTF8String); + return; + } + decisionHandler (WKNavigationResponsePolicyAllow); + + self.urlScriptBlocked[navigationResponse.response.URL] = + [NSNumber numberWithBool:NO]; + if ([navigationResponse.response isKindOfClass:[NSHTTPURLResponse class]]) + { + NSDictionary *headers = + ((NSHTTPURLResponse *) navigationResponse.response).allHeaderFields; + NSString *value = headers[@"Content-Security-Policy"]; + if (value) + { + /* TODO: Sloppy parsing of 'Content-Security-Policy' value. */ + NSRange sandbox = [value rangeOfString:@"sandbox"]; + if (sandbox.location != NSNotFound + && (sandbox.location == 0 + || [value characterAtIndex:(sandbox.location - 1)] == ' ' + || [value characterAtIndex:(sandbox.location - 1)] == ';')) + { + NSRange allowScripts = [value rangeOfString:@"allow-scripts"]; + if (allowScripts.location == NSNotFound + || allowScripts.location < sandbox.location) + self.urlScriptBlocked[navigationResponse.response.URL] = + [NSNumber numberWithBool:YES]; + } + } + } +} + +/* No additional new webview or emacs window will be created + for <a ... target="_blank">. */ +- (WKWebView *)webView:(WKWebView *)webView +createWebViewWithConfiguration:(WKWebViewConfiguration *)configuration + forNavigationAction:(WKNavigationAction *)navigationAction + windowFeatures:(WKWindowFeatures *)windowFeatures +{ + if (!navigationAction.targetFrame.isMainFrame) + [webView loadRequest:navigationAction.request]; + return nil; +} + +/* Open panel for file upload. */ +- (void)webView:(WKWebView *)webView +runOpenPanelWithParameters:(WKOpenPanelParameters *)parameters +initiatedByFrame:(WKFrameInfo *)frame +completionHandler:(void (^)(NSArray<NSURL *> *URLs))completionHandler +{ + NSOpenPanel *openPanel = [NSOpenPanel openPanel]; + openPanel.canChooseFiles = YES; + openPanel.canChooseDirectories = NO; + openPanel.allowsMultipleSelection = parameters.allowsMultipleSelection; + if ([openPanel runModal] == NSModalResponseOK) + completionHandler (openPanel.URLs); + else + completionHandler (nil); +} + +/* By forwarding mouse events to emacs view (frame) + - Mouse click in webview selects the window contains the webview. + - Correct mouse hand/arrow/I-beam is displayed (TODO: not perfect yet). +*/ + +- (void)mouseDown:(NSEvent *)event +{ + [self.xw->xv->emacswindow mouseDown:event]; + [super mouseDown:event]; +} + +- (void)mouseUp:(NSEvent *)event +{ + [self.xw->xv->emacswindow mouseUp:event]; + [super mouseUp:event]; +} + +/* Basically we want keyboard events handled by emacs unless an input + element has focus. Especially, while incremental search, we set + emacs as first responder to avoid focus held in an input element + with matching text. */ + +- (void)keyDown:(NSEvent *)event +{ + Lisp_Object var = Fintern (build_string ("isearch-mode"), Qnil); + Lisp_Object val = buffer_local_value (var, Fcurrent_buffer ()); + if (!EQ (val, Qunbound) && !EQ (val, Qnil)) + { + [self.window makeFirstResponder:self.xw->xv->emacswindow]; + [self.xw->xv->emacswindow keyDown:event]; + return; + } + + /* Emacs handles keyboard events when javascript is blocked. */ + if ([self.urlScriptBlocked[self.URL] boolValue]) + { + [self.xw->xv->emacswindow keyDown:event]; + return; + } + + [self evaluateJavaScript:@"xwHasFocus()" + completionHandler:^(id result, NSError *error) { + if (error) + { + NSLog (@"xwHasFocus: %@", error); + [self.xw->xv->emacswindow keyDown:event]; + } + else if (result) + { + NSNumber *hasFocus = result; /* __NSCFBoolean */ + if (!hasFocus.boolValue) + [self.xw->xv->emacswindow keyDown:event]; + else + [super keyDown:event]; + } + }]; +} + +- (void)interpretKeyEvents:(NSArray<NSEvent *> *)eventArray +{ + /* We should do nothing and do not forward (default implementation + if we not override here) to let emacs collect key events and ask + interpretKeyEvents to its superclass. */ +} + +static NSString *xwScript; ++ (void)initialize +{ + /* Find out if an input element has focus. + Message to script message handler when 'C-g' key down. */ + if (!xwScript) + xwScript = + @"function xwHasFocus() {" + @" var ae = document.activeElement;" + @" if (ae) {" + @" var name = ae.nodeName;" + @" return name == 'INPUT' || name == 'TEXTAREA';" + @" } else {" + @" return false;" + @" }" + @"}" + @"function xwKeyDown(event) {" + @" if (event.ctrlKey && event.key == 'g') {" + @" window.webkit.messageHandlers.keyDown.postMessage('C-g');" + @" }" + @"}" + @"document.addEventListener('keydown', xwKeyDown);" + ; +} + +/* Confirming to WKScriptMessageHandler, listens concerning keyDown in + webkit. Currently 'C-g'. */ +- (void)userContentController:(WKUserContentController *)userContentController + didReceiveScriptMessage:(WKScriptMessage *)message +{ + if ([message.body isEqualToString:@"C-g"]) + { + /* Just give up focus, no relay "C-g" to emacs, another "C-g" + follows will be handled by emacs. */ + [self.window makeFirstResponder:self.xw->xv->emacswindow]; + } +} + +@end + +/* Xwidget webkit commands. */ + +static Lisp_Object build_string_with_nsstr (NSString *nsstr); + +bool +nsxwidget_is_web_view (struct xwidget *xw) +{ + return xw->xwWidget != NULL && + [xw->xwWidget isKindOfClass:WKWebView.class]; +} + +Lisp_Object +nsxwidget_webkit_uri (struct xwidget *xw) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + return build_string_with_nsstr (xwWebView.URL.absoluteString); +} + +Lisp_Object +nsxwidget_webkit_title (struct xwidget *xw) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + return build_string_with_nsstr (xwWebView.title); +} + +/* @Note ATS - Need application transport security in 'Info.plist' or + remote pages will not loaded. */ +void +nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + NSString *urlString = [NSString stringWithUTF8String:uri]; + NSURL *url = [NSURL URLWithString:urlString]; + NSURLRequest *urlRequest = [NSURLRequest requestWithURL:url]; + [xwWebView loadRequest:urlRequest]; +} + +void +nsxwidget_webkit_goto_history (struct xwidget *xw, int rel_pos) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + switch (rel_pos) { + case -1: [xwWebView goBack]; break; + case 0: [xwWebView reload]; break; + case 1: [xwWebView goForward]; break; + } +} + +void +nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + xwWebView.magnification += zoom_change; + /* TODO: setMagnification:centeredAtPoint. */ +} + +/* Build lisp string */ +static Lisp_Object +build_string_with_nsstr (NSString *nsstr) +{ + const char *utfstr = [nsstr UTF8String]; + NSUInteger bytes = [nsstr lengthOfBytesUsingEncoding:NSUTF8StringEncoding]; + return make_string (utfstr, bytes); +} + +/* Recursively convert an objc native type JavaScript value to a Lisp + value. Mostly copied from GTK xwidget 'webkit_js_to_lisp'. */ +static Lisp_Object +js_to_lisp (id value) +{ + if (value == nil || [value isKindOfClass:NSNull.class]) + return Qnil; + else if ([value isKindOfClass:NSString.class]) + return build_string_with_nsstr ((NSString *) value); + else if ([value isKindOfClass:NSNumber.class]) + { + NSNumber *nsnum = (NSNumber *) value; + char type = nsnum.objCType[0]; + if (type == 'c') /* __NSCFBoolean has type character 'c'. */ + return nsnum.boolValue? Qt : Qnil; + else + { + if (type == 'i' || type == 'l') + return make_int (nsnum.longValue); + else if (type == 'f' || type == 'd') + return make_float (nsnum.doubleValue); + /* else fall through. */ + } + } + else if ([value isKindOfClass:NSArray.class]) + { + NSArray *nsarr = (NSArray *) value; + EMACS_INT n = nsarr.count; + Lisp_Object obj; + struct Lisp_Vector *p = allocate_nil_vector (n); + + for (ptrdiff_t i = 0; i < n; ++i) + p->contents[i] = js_to_lisp ([nsarr objectAtIndex:i]); + XSETVECTOR (obj, p); + return obj; + } + else if ([value isKindOfClass:NSDictionary.class]) + { + NSDictionary *nsdict = (NSDictionary *) value; + NSArray *keys = nsdict.allKeys; + ptrdiff_t n = keys.count; + Lisp_Object obj; + struct Lisp_Vector *p = allocate_nil_vector (n); + + for (ptrdiff_t i = 0; i < n; ++i) + { + NSString *prop_key = (NSString *) [keys objectAtIndex:i]; + id prop_value = [nsdict valueForKey:prop_key]; + p->contents[i] = Fcons (build_string_with_nsstr (prop_key), + js_to_lisp (prop_value)); + } + XSETVECTOR (obj, p); + return obj; + } + NSLog (@"Unhandled type in javascript result"); + return Qnil; +} + +void +nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script, + Lisp_Object fun) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + if ([xwWebView.urlScriptBlocked[xwWebView.URL] boolValue]) + { + message ("Javascript is blocked by 'CSP: sandbox'."); + return; + } + + NSString *javascriptString = [NSString stringWithUTF8String:script]; + [xwWebView evaluateJavaScript:javascriptString + completionHandler:^(id result, NSError *error) { + if (error) + { + NSLog (@"evaluateJavaScript error : %@", error.localizedDescription); + NSLog (@"error script=%@", javascriptString); + } + else if (result && FUNCTIONP (fun)) + { + // NSLog (@"result=%@, type=%@", result, [result class]); + Lisp_Object lisp_value = js_to_lisp (result); + store_xwidget_js_callback_event (xw, fun, lisp_value); + } + }]; +} + +/* Window containing an xwidget. */ + +@implementation XwWindow +- (BOOL)isFlipped { return YES; } +@end + +/* Xwidget model, macOS Cocoa part. */ + +void +nsxwidget_init(struct xwidget *xw) +{ + block_input (); + NSRect rect = NSMakeRect (0, 0, xw->width, xw->height); + xw->xwWidget = [[XwWebView alloc] + initWithFrame:rect + configuration:[[WKWebViewConfiguration alloc] init] + xwidget:xw]; + xw->xwWindow = [[XwWindow alloc] + initWithFrame:rect]; + [xw->xwWindow addSubview:xw->xwWidget]; + xw->xv = NULL; /* for 1 to 1 relationship of webkit2. */ + unblock_input (); +} + +void +nsxwidget_kill (struct xwidget *xw) +{ + if (xw) + { + WKUserContentController *scriptor = + ((XwWebView *) xw->xwWidget).configuration.userContentController; + [scriptor removeAllUserScripts]; + [scriptor removeScriptMessageHandlerForName:@"keyDown"]; + [scriptor release]; + if (xw->xv) + xw->xv->model = Qnil; /* Make sure related view stale. */ + + /* This stops playing audio when a xwidget-webkit buffer is + killed. I could not find other solution. */ + nsxwidget_webkit_goto_uri (xw, "about:blank"); + + [((XwWebView *) xw->xwWidget).urlScriptBlocked release]; + [xw->xwWidget removeFromSuperviewWithoutNeedingDisplay]; + [xw->xwWidget release]; + [xw->xwWindow removeFromSuperviewWithoutNeedingDisplay]; + [xw->xwWindow release]; + xw->xwWidget = nil; + } +} + +void +nsxwidget_resize (struct xwidget *xw) +{ + if (xw->xwWidget) + { + [xw->xwWindow setFrameSize:NSMakeSize(xw->width, xw->height)]; + [xw->xwWidget setFrameSize:NSMakeSize(xw->width, xw->height)]; + } +} + +Lisp_Object +nsxwidget_get_size (struct xwidget *xw) +{ + return list2i (xw->xwWidget.frame.size.width, + xw->xwWidget.frame.size.height); +} + +/* Xwidget view, macOS Cocoa part. */ + +@implementation XvWindow : NSView +- (BOOL)isFlipped { return YES; } +@end + +void +nsxwidget_init_view (struct xwidget_view *xv, + struct xwidget *xw, + struct glyph_string *s, + int x, int y) +{ + /* 'x_draw_xwidget_glyph_string' will calculate correct position and + size of clip to draw in emacs buffer window. Thus, just begin at + origin with no crop. */ + xv->x = x; + xv->y = y; + xv->clip_left = 0; + xv->clip_right = xw->width; + xv->clip_top = 0; + xv->clip_bottom = xw->height; + + xv->xvWindow = [[XvWindow alloc] + initWithFrame:NSMakeRect (x, y, xw->width, xw->height)]; + xv->xvWindow.xw = xw; + xv->xvWindow.xv = xv; + + xw->xv = xv; /* For 1 to 1 relationship of webkit2. */ + [xv->xvWindow addSubview:xw->xwWindow]; + + xv->emacswindow = FRAME_NS_VIEW (s->f); + [xv->emacswindow addSubview:xv->xvWindow]; +} + +void +nsxwidget_delete_view (struct xwidget_view *xv) +{ + if (!EQ (xv->model, Qnil)) + { + struct xwidget *xw = XXWIDGET (xv->model); + [xw->xwWindow removeFromSuperviewWithoutNeedingDisplay]; + xw->xv = NULL; /* Now model has no view. */ + } + [xv->xvWindow removeFromSuperviewWithoutNeedingDisplay]; + [xv->xvWindow release]; +} + +void +nsxwidget_show_view (struct xwidget_view *xv) +{ + xv->hidden = NO; + [xv->xvWindow setFrameOrigin:NSMakePoint(xv->x + xv->clip_left, + xv->y + xv->clip_top)]; +} + +void +nsxwidget_hide_view (struct xwidget_view *xv) +{ + xv->hidden = YES; + [xv->xvWindow setFrameOrigin:NSMakePoint(10000, 10000)]; +} + +void +nsxwidget_resize_view (struct xwidget_view *xv, int width, int height) +{ + [xv->xvWindow setFrameSize:NSMakeSize(width, height)]; +} + +void +nsxwidget_move_view (struct xwidget_view *xv, int x, int y) +{ + [xv->xvWindow setFrameOrigin:NSMakePoint (x, y)]; +} + +/* Move model window in container (view window). */ +void +nsxwidget_move_widget_in_view (struct xwidget_view *xv, int x, int y) +{ + struct xwidget *xww = xv->xvWindow.xw; + [xww->xwWindow setFrameOrigin:NSMakePoint (x, y)]; +} + +void +nsxwidget_set_needsdisplay (struct xwidget_view *xv) +{ + xv->xvWindow.needsDisplay = YES; +} diff --git a/src/pdumper.c b/src/pdumper.c index 63ee0fcb7f6..217ffa67839 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -71,17 +71,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifdef HAVE_PDUMPER #if GNUC_PREREQ (4, 7, 0) -# pragma GCC diagnostic error "-Wconversion" -# pragma GCC diagnostic ignored "-Wsign-conversion" # pragma GCC diagnostic error "-Wshadow" -# define ALLOW_IMPLICIT_CONVERSION \ - _Pragma ("GCC diagnostic push") \ - _Pragma ("GCC diagnostic ignored \"-Wconversion\"") -# define DISALLOW_IMPLICIT_CONVERSION \ - _Pragma ("GCC diagnostic pop") -#else -# define ALLOW_IMPLICIT_CONVERSION ((void) 0) -# define DISALLOW_IMPLICIT_CONVERSION ((void) 0) #endif #define VM_POSIX 1 @@ -105,17 +95,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # define VM_SUPPORTED 0 #endif -/* PDUMPER_CHECK_REHASHING being true causes the portable dumper to - check, for each hash table it dumps, that the hash table means the - same thing after rehashing. */ -#ifndef PDUMPER_CHECK_REHASHING -# if ENABLE_CHECKING -# define PDUMPER_CHECK_REHASHING 1 -# else -# define PDUMPER_CHECK_REHASHING 0 -# endif -#endif - /* Require an architecture in which pointers, ptrdiff_t and intptr_t are the same size and have the same layout, and where bytes have eight bits --- that is, a general-purpose computer made after 1990. @@ -152,8 +131,11 @@ static int nr_remembered_data = 0; typedef int_least32_t dump_off; #define DUMP_OFF_MIN INT_LEAST32_MIN #define DUMP_OFF_MAX INT_LEAST32_MAX +#define PRIdDUMP_OFF PRIdLEAST32 + +enum { EMACS_INT_XDIGITS = (EMACS_INT_WIDTH + 3) / 4 }; -static void ATTRIBUTE_FORMAT ((printf, 1, 2)) +static void ATTRIBUTE_FORMAT_PRINTF (1, 2) dump_trace (const char *fmt, ...) { if (0) @@ -324,9 +306,7 @@ static void dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset) { eassert (offset >= 0); - ALLOW_IMPLICIT_CONVERSION; reloc->raw_offset = offset >> DUMP_RELOC_ALIGNMENT_BITS; - DISALLOW_IMPLICIT_CONVERSION; if (dump_reloc_get_offset (*reloc) != offset) error ("dump relocation out of range"); } @@ -401,6 +381,9 @@ struct dump_header The start of the cold region is always aligned on a page boundary. */ dump_off cold_start; + + /* Offset of a vector of the dumped hash tables. */ + dump_off hash_list; }; /* Double-ended singly linked list. */ @@ -558,8 +541,11 @@ struct dump_context heap objects. */ Lisp_Object bignum_data; - unsigned number_hot_relocations; - unsigned number_discardable_relocations; + /* List of hash tables that have been dumped. */ + Lisp_Object hash_tables; + + dump_off number_hot_relocations; + dump_off number_discardable_relocations; }; /* These special values for use as offsets in dump_remember_object and @@ -746,10 +732,7 @@ dump_off_from_lisp (Lisp_Object value) { intmax_t n = intmax_t_from_lisp (value); eassert (DUMP_OFF_MIN <= n && n <= DUMP_OFF_MAX); - ALLOW_IMPLICIT_CONVERSION; - dump_off converted = n; - DISALLOW_IMPLICIT_CONVERSION; - return converted; + return n; } static Lisp_Object @@ -966,11 +949,9 @@ dump_queue_init (struct dump_queue *dump_queue) static bool dump_queue_empty_p (struct dump_queue *dump_queue) { - bool is_empty = - EQ (Fhash_table_count (dump_queue->sequence_numbers), - make_fixnum (0)); - eassert (EQ (Fhash_table_count (dump_queue->sequence_numbers), - Fhash_table_count (dump_queue->link_weights))); + ptrdiff_t count = XHASH_TABLE (dump_queue->sequence_numbers)->count; + bool is_empty = count == 0; + eassert (count == XFIXNAT (Fhash_table_count (dump_queue->link_weights))); if (!is_empty) { eassert (!dump_tailq_empty_p (&dump_queue->zero_weight_objects) @@ -1012,9 +993,9 @@ dump_queue_enqueue (struct dump_queue *dump_queue, if (NILP (weights)) { /* Object is new. */ - dump_trace ("new object %016x weight=%u\n", - (unsigned) XLI (object), - (unsigned) weight.value); + EMACS_UINT uobj = XLI (object); + dump_trace ("new object %0*"pI"x weight=%d\n", EMACS_INT_XDIGITS, uobj, + weight.value); if (weight.value == WEIGHT_NONE.value) { @@ -1229,17 +1210,15 @@ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis) + dump_tailq_length (&dump_queue->one_weight_normal_objects) + dump_tailq_length (&dump_queue->one_weight_strong_objects))); - bool dump_object_counts = true; - if (dump_object_counts) - dump_trace - ("dump_queue_dequeue basis=%d fancy=%u zero=%u " - "normal=%u strong=%u hash=%u\n", - basis, - (unsigned) dump_tailq_length (&dump_queue->fancy_weight_objects), - (unsigned) dump_tailq_length (&dump_queue->zero_weight_objects), - (unsigned) dump_tailq_length (&dump_queue->one_weight_normal_objects), - (unsigned) dump_tailq_length (&dump_queue->one_weight_strong_objects), - (unsigned) XFIXNUM (Fhash_table_count (dump_queue->link_weights))); + dump_trace + (("dump_queue_dequeue basis=%"PRIdDUMP_OFF" fancy=%"PRIdPTR + " zero=%"PRIdPTR" normal=%"PRIdPTR" strong=%"PRIdPTR" hash=%td\n"), + basis, + dump_tailq_length (&dump_queue->fancy_weight_objects), + dump_tailq_length (&dump_queue->zero_weight_objects), + dump_tailq_length (&dump_queue->one_weight_normal_objects), + dump_tailq_length (&dump_queue->one_weight_strong_objects), + XHASH_TABLE (dump_queue->link_weights)->count); static const int nr_candidates = 3; struct candidate @@ -1312,10 +1291,10 @@ dump_queue_dequeue (struct dump_queue *dump_queue, dump_off basis) else emacs_abort (); - dump_trace (" result score=%f src=%s object=%016x\n", + EMACS_UINT uresult = XLI (result); + dump_trace (" result score=%f src=%s object=%0*"pI"x\n", best < 0 ? -1.0 : (double) candidates[best].score, - src, - (unsigned) XLI (result)); + src, EMACS_INT_XDIGITS, uresult); { Lisp_Object weights = Fgethash (result, dump_queue->link_weights, Qnil); @@ -2000,11 +1979,7 @@ static dump_off finish_dump_pvec (struct dump_context *ctx, union vectorlike_header *out_hdr) { - ALLOW_IMPLICIT_CONVERSION; - dump_off result = dump_object_finish (ctx, out_hdr, - vectorlike_nbytes (out_hdr)); - DISALLOW_IMPLICIT_CONVERSION; - return result; + return dump_object_finish (ctx, out_hdr, vectorlike_nbytes (out_hdr)); } static void @@ -2616,78 +2591,65 @@ dump_vectorlike_generic (struct dump_context *ctx, return offset; } -/* Determine whether the hash table's hash order is stable - across dump and load. If it is, we don't have to trigger - a rehash on access. */ -static bool -dump_hash_table_stable_p (const struct Lisp_Hash_Table *hash) +/* Return a vector of KEY, VALUE pairs in the given hash table H. The + first H->count pairs are valid, and the rest are unbound. */ +static Lisp_Object +hash_table_contents (struct Lisp_Hash_Table *h) { - if (hash->test.hashfn == hashfn_user_defined) + if (h->test.hashfn == hashfn_user_defined) error ("cannot dump hash tables with user-defined tests"); /* Bug#36769 */ - bool is_eql = hash->test.hashfn == hashfn_eql; - bool is_equal = hash->test.hashfn == hashfn_equal; - ptrdiff_t size = HASH_TABLE_SIZE (hash); - for (ptrdiff_t i = 0; i < size; ++i) + + ptrdiff_t size = HASH_TABLE_SIZE (h); + Lisp_Object key_and_value = make_uninit_vector (2 * size); + ptrdiff_t n = 0; + + /* Make sure key_and_value ends up in the same order; charset.c + relies on it by expecting hash table indices to stay constant + across the dump. */ + for (ptrdiff_t i = 0; i < size; i++) + if (!NILP (HASH_HASH (h, i))) + { + ASET (key_and_value, n++, HASH_KEY (h, i)); + ASET (key_and_value, n++, HASH_VALUE (h, i)); + } + + while (n < 2 * size) { - Lisp_Object key = HASH_KEY (hash, i); - if (!EQ (key, Qunbound)) - { - bool key_stable = (dump_builtin_symbol_p (key) - || FIXNUMP (key) - || (is_equal - && (STRINGP (key) || BOOL_VECTOR_P (key))) - || ((is_equal || is_eql) - && (FLOATP (key) || BIGNUMP (key)))); - if (!key_stable) - return false; - } + ASET (key_and_value, n++, Qunbound); + ASET (key_and_value, n++, Qnil); } - return true; + return key_and_value; } -/* Return a list of (KEY . VALUE) pairs in the given hash table. */ -static Lisp_Object -hash_table_contents (Lisp_Object table) +static dump_off +dump_hash_table_list (struct dump_context *ctx) { - Lisp_Object contents = Qnil; - struct Lisp_Hash_Table *h = XHASH_TABLE (table); - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) - { - Lisp_Object key = HASH_KEY (h, i); - if (!EQ (key, Qunbound)) - dump_push (&contents, Fcons (key, HASH_VALUE (h, i))); - } - return Fnreverse (contents); + if (!NILP (ctx->hash_tables)) + return dump_object (ctx, CALLN (Fapply, Qvector, ctx->hash_tables)); + else + return 0; } -/* Copy the given hash table, rehash it, and make sure that we can - look up all the values in the original. */ static void -check_hash_table_rehash (Lisp_Object table_orig) -{ - ptrdiff_t count = XHASH_TABLE (table_orig)->count; - hash_rehash_if_needed (XHASH_TABLE (table_orig)); - Lisp_Object table_rehashed = Fcopy_hash_table (table_orig); - eassert (!hash_rehash_needed_p (XHASH_TABLE (table_rehashed))); - XHASH_TABLE (table_rehashed)->hash = Qnil; - eassert (count == 0 || hash_rehash_needed_p (XHASH_TABLE (table_rehashed))); - hash_rehash_if_needed (XHASH_TABLE (table_rehashed)); - eassert (!hash_rehash_needed_p (XHASH_TABLE (table_rehashed))); - Lisp_Object expected_contents = hash_table_contents (table_orig); - while (!NILP (expected_contents)) - { - Lisp_Object key_value_pair = dump_pop (&expected_contents); - Lisp_Object key = XCAR (key_value_pair); - Lisp_Object expected_value = XCDR (key_value_pair); - Lisp_Object arbitrary = Qdump_emacs_portable__sort_predicate_copied; - Lisp_Object found_value = Fgethash (key, table_rehashed, arbitrary); - eassert (EQ (expected_value, found_value)); - Fremhash (key, table_rehashed); - } +hash_table_freeze (struct Lisp_Hash_Table *h) +{ + ptrdiff_t npairs = ASIZE (h->key_and_value) / 2; + h->key_and_value = hash_table_contents (h); + h->next = h->hash = make_fixnum (npairs); + h->index = make_fixnum (ASIZE (h->index)); + h->next_free = (npairs == h->count ? -1 : h->count); +} - eassert (EQ (Fhash_table_count (table_rehashed), - make_fixnum (0))); +static void +hash_table_thaw (Lisp_Object hash) +{ + struct Lisp_Hash_Table *h = XHASH_TABLE (hash); + h->hash = make_nil_vector (XFIXNUM (h->hash)); + h->next = Fmake_vector (h->next, make_fixnum (-1)); + h->index = Fmake_vector (h->index, make_fixnum (-1)); + + hash_table_rehash (hash); } static dump_off @@ -2695,55 +2657,15 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_12AFBF47AF +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); - bool is_stable = dump_hash_table_stable_p (hash_in); - /* If the hash table is likely to be modified in memory (either - because we need to rehash, and thus toggle hash->count, or - because we need to assemble a list of weak tables) punt the hash - table to the end of the dump, where we can lump all such hash - tables together. */ - if (!(is_stable || !NILP (hash_in->weak)) - && ctx->flags.defer_hash_tables) - { - if (offset != DUMP_OBJECT_ON_HASH_TABLE_QUEUE) - { - eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE - || offset == DUMP_OBJECT_NOT_SEEN); - /* We still want to dump the actual keys and values now. */ - dump_enqueue_object (ctx, hash_in->key_and_value, WEIGHT_NONE); - /* We'll get to the rest later. */ - offset = DUMP_OBJECT_ON_HASH_TABLE_QUEUE; - dump_remember_object (ctx, object, offset); - dump_push (&ctx->deferred_hash_tables, object); - } - return offset; - } - - if (PDUMPER_CHECK_REHASHING) - check_hash_table_rehash (make_lisp_ptr ((void *) hash_in, Lisp_Vectorlike)); - struct Lisp_Hash_Table hash_munged = *hash_in; struct Lisp_Hash_Table *hash = &hash_munged; - /* Remember to rehash this hash table on first access. After a - dump reload, the hash table values will have changed, so we'll - need to rebuild the index. - - TODO: for EQ and EQL hash tables, it should be possible to rehash - here using the preferred load address of the dump, eliminating - the need to rehash-on-access if we can load the dump where we - want. */ - if (hash->count > 0 && !is_stable) - /* Hash codes will have to be recomputed anyway, so let's not dump them. - Also set `hash` to nil for hash_rehash_needed_p. - We could also refrain from dumping the `next' and `index' vectors, - except that `next' is currently used for HASH_TABLE_SIZE and - we'd have to rebuild the next_free list as well as adjust - sweep_weak_hash_table for the case where there's no `index'. */ - hash->hash = Qnil; + hash_table_freeze (hash); + dump_push (&ctx->hash_tables, object); START_DUMP_PVEC (ctx, &hash->header, struct Lisp_Hash_Table, out); dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header); @@ -3355,9 +3277,7 @@ static void dump_cold_charset (struct dump_context *ctx, Lisp_Object data) { /* Dump charset lookup tables. */ - ALLOW_IMPLICIT_CONVERSION; int cs_i = XFIXNUM (XCAR (data)); - DISALLOW_IMPLICIT_CONVERSION; dump_off cs_dump_offset = dump_off_from_lisp (XCDR (data)); dump_remember_fixup_ptr_raw (ctx, @@ -3665,9 +3585,7 @@ static struct emacs_reloc decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc) { struct emacs_reloc reloc = {0}; - ALLOW_IMPLICIT_CONVERSION; int type = XFIXNUM (dump_pop (&lreloc)); - DISALLOW_IMPLICIT_CONVERSION; reloc.emacs_offset = dump_off_from_lisp (dump_pop (&lreloc)); dump_check_emacs_off (reloc.emacs_offset); switch (type) @@ -3678,9 +3596,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc) reloc.u.dump_offset = dump_off_from_lisp (dump_pop (&lreloc)); dump_check_dump_off (ctx, reloc.u.dump_offset); dump_off length = dump_off_from_lisp (dump_pop (&lreloc)); - ALLOW_IMPLICIT_CONVERSION; reloc.length = length; - DISALLOW_IMPLICIT_CONVERSION; if (reloc.length != length) error ("relocation copy length too large"); } @@ -3691,9 +3607,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc) intmax_t value = intmax_t_from_lisp (dump_pop (&lreloc)); dump_off size = dump_off_from_lisp (dump_pop (&lreloc)); reloc.u.immediate = value; - ALLOW_IMPLICIT_CONVERSION; reloc.length = size; - DISALLOW_IMPLICIT_CONVERSION; eassert (reloc.length == size); } break; @@ -3718,9 +3632,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc) RELOC_EMACS_IMMEDIATE relocation instead. */ eassert (!dump_object_self_representing_p (target_value)); int tag_type = XTYPE (target_value); - ALLOW_IMPLICIT_CONVERSION; reloc.length = tag_type; - DISALLOW_IMPLICIT_CONVERSION; eassert (reloc.length == tag_type); if (type == RELOC_EMACS_EMACS_LV) @@ -3795,9 +3707,7 @@ dump_merge_emacs_relocs (Lisp_Object lreloc_a, Lisp_Object lreloc_b) return Qnil; dump_off new_length = reloc_a.length + reloc_b.length; - ALLOW_IMPLICIT_CONVERSION; reloc_a.length = new_length; - DISALLOW_IMPLICIT_CONVERSION; if (reloc_a.length != new_length) return Qnil; /* Overflow */ @@ -4151,6 +4061,19 @@ types. */) || !NILP (ctx->deferred_hash_tables) || !NILP (ctx->deferred_symbols)); + ctx->header.hash_list = ctx->offset; + dump_hash_table_list (ctx); + + do + { + dump_drain_deferred_hash_tables (ctx); + dump_drain_deferred_symbols (ctx); + dump_drain_normal_queue (ctx); + } + while (!dump_queue_empty_p (&ctx->dump_queue) + || !NILP (ctx->deferred_hash_tables) + || !NILP (ctx->deferred_symbols)); + dump_sort_copied_objects (ctx); /* While we copy built-in symbols into the Emacs image, these @@ -4210,9 +4133,9 @@ types. */) of the dump. */ drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger, &ctx->dump_relocs, &ctx->header.dump_relocs); - unsigned number_hot_relocations = ctx->number_hot_relocations; + dump_off number_hot_relocations = ctx->number_hot_relocations; ctx->number_hot_relocations = 0; - unsigned number_discardable_relocations = ctx->number_discardable_relocations; + dump_off number_discardable_relocations = ctx->number_discardable_relocations; ctx->number_discardable_relocations = 0; drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger, &ctx->object_starts, &ctx->header.object_starts); @@ -4236,14 +4159,17 @@ types. */) dump_seek (ctx, 0); dump_write (ctx, &ctx->header, sizeof (ctx->header)); + dump_off + header_bytes = header_end - header_start, + hot_bytes = hot_end - hot_start, + discardable_bytes = discardable_end - ctx->header.discardable_start, + cold_bytes = cold_end - ctx->header.cold_start; fprintf (stderr, ("Dump complete\n" - "Byte counts: header=%lu hot=%lu discardable=%lu cold=%lu\n" - "Reloc counts: hot=%u discardable=%u\n"), - (unsigned long) (header_end - header_start), - (unsigned long) (hot_end - hot_start), - (unsigned long) (discardable_end - ctx->header.discardable_start), - (unsigned long) (cold_end - ctx->header.cold_start), + "Byte counts: header=%"PRIdDUMP_OFF" hot=%"PRIdDUMP_OFF + " discardable=%"PRIdDUMP_OFF" cold=%"PRIdDUMP_OFF"\n" + "Reloc counts: hot=%"PRIdDUMP_OFF" discardable=%"PRIdDUMP_OFF"\n"), + header_bytes, hot_bytes, discardable_bytes, cold_bytes, number_hot_relocations, number_discardable_relocations); @@ -4876,14 +4802,19 @@ struct dump_bitset }; static bool -dump_bitset_init (struct dump_bitset *bitset, size_t number_bits) +dump_bitsets_init (struct dump_bitset bitset[2], size_t number_bits) { - int xword_size = sizeof (bitset->bits[0]); + int xword_size = sizeof (bitset[0].bits[0]); int bits_per_word = xword_size * CHAR_BIT; ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word); - bitset->number_words = words_needed; - bitset->bits = calloc (words_needed, xword_size); - return bitset->bits != NULL; + dump_bitset_word *bits = calloc (words_needed, 2 * xword_size); + if (!bits) + return false; + bitset[0].bits = bits; + bitset[0].number_words = bitset[1].number_words = words_needed; + bitset[1].bits = memset (bits + words_needed, UCHAR_MAX, + words_needed * xword_size); + return true; } static dump_bitset_word * @@ -4944,7 +4875,7 @@ struct pdumper_loaded_dump_private /* Copy of the header we read from the dump. */ struct dump_header header; /* Mark bits for objects in the dump; used during GC. */ - struct dump_bitset mark_bits; + struct dump_bitset mark_bits, last_mark_bits; /* Time taken to load the dump. */ double load_time; /* Dump file name. */ @@ -5067,6 +4998,10 @@ pdumper_find_object_type_impl (const void *obj) dump_off offset = ptrdiff_t_to_dump_off ((uintptr_t) obj - dump_public.start); if (offset % DUMP_ALIGNMENT != 0) return PDUMPER_NO_OBJECT; + ptrdiff_t bitno = offset / DUMP_ALIGNMENT; + if (offset < dump_private.header.discardable_start + && !dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno)) + return PDUMPER_NO_OBJECT; const struct dump_reloc *reloc = dump_find_relocation (&dump_private.header.object_starts, offset); return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset) @@ -5095,12 +5030,16 @@ pdumper_set_marked_impl (const void *obj) eassert (offset < dump_private.header.cold_start); eassert (offset < dump_private.header.discardable_start); ptrdiff_t bitno = offset / DUMP_ALIGNMENT; + eassert (dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno)); dump_bitset_set_bit (&dump_private.mark_bits, bitno); } void pdumper_clear_marks_impl (void) { + dump_bitset_word *swap = dump_private.last_mark_bits.bits; + dump_private.last_mark_bits.bits = dump_private.mark_bits.bits; + dump_private.mark_bits.bits = swap; dump_bitset_clear (&dump_private.mark_bits); } @@ -5109,14 +5048,13 @@ dump_read_all (int fd, void *buf, size_t bytes_to_read) { /* We don't want to use emacs_read, since that relies on the lisp world, and we're not in the lisp world yet. */ - eassert (bytes_to_read <= SSIZE_MAX); size_t bytes_read = 0; while (bytes_read < bytes_to_read) { - /* Some platforms accept only int-sized values to read. */ - unsigned chunk_to_read = INT_MAX; - if (bytes_to_read - bytes_read < chunk_to_read) - chunk_to_read = (unsigned) (bytes_to_read - bytes_read); + /* Some platforms accept only int-sized values to read. + Round this down to a page size (see MAX_RW_COUNT in sysdep.c). */ + int max_rw_count = INT_MAX >> 18 << 18; + int chunk_to_read = min (bytes_to_read - bytes_read, max_rw_count); ssize_t chunk = read (fd, (char *) buf + bytes_read, chunk_to_read); if (chunk < 0) return chunk; @@ -5302,6 +5240,9 @@ enum dump_section NUMBER_DUMP_SECTIONS, }; +/* Pointer to a stack variable to avoid having to staticpro it. */ +static Lisp_Object *pdumper_hashes = &zero_vector; + /* Load a dump from DUMP_FILENAME. Return an error code. N.B. We run very early in initialization, so we can't use lisp, @@ -5315,7 +5256,7 @@ pdumper_load (const char *dump_filename) int dump_page_size; dump_off adj_discardable_start; - struct dump_bitset mark_bits; + struct dump_bitset mark_bits[2]; size_t mark_bits_needed; struct dump_header header_buf = { 0 }; @@ -5429,7 +5370,7 @@ pdumper_load (const char *dump_filename) err = PDUMPER_LOAD_ERROR; mark_bits_needed = divide_round_up (header->discardable_start, DUMP_ALIGNMENT); - if (!dump_bitset_init (&mark_bits, mark_bits_needed)) + if (!dump_bitsets_init (mark_bits, mark_bits_needed)) goto out; /* Point of no return. */ @@ -5437,7 +5378,8 @@ pdumper_load (const char *dump_filename) dump_base = (uintptr_t) sections[DS_HOT].mapping; gflags.dumped_with_pdumper_ = true; dump_private.header = *header; - dump_private.mark_bits = mark_bits; + dump_private.mark_bits = mark_bits[0]; + dump_private.last_mark_bits = mark_bits[1]; dump_public.start = dump_base; dump_public.end = dump_public.start + dump_size; @@ -5448,6 +5390,15 @@ pdumper_load (const char *dump_filename) for (int i = 0; i < ARRAYELTS (sections); ++i) dump_mmap_reset (§ions[i]); + Lisp_Object hashes = zero_vector; + if (header->hash_list) + { + struct Lisp_Vector *hash_tables = + (struct Lisp_Vector *) (dump_base + header->hash_list); + hashes = make_lisp_ptr (hash_tables, Lisp_Vectorlike); + } + + pdumper_hashes = &hashes; /* Run the functions Emacs registered for doing post-dump-load initialization. */ for (int i = 0; i < nr_dump_hooks; ++i) @@ -5518,6 +5469,19 @@ Value is nil if this session was not started using a dump file.*/) #endif /* HAVE_PDUMPER */ +static void +thaw_hash_tables (void) +{ + Lisp_Object hash_tables = *pdumper_hashes; + for (ptrdiff_t i = 0; i < ASIZE (hash_tables); i++) + hash_table_thaw (AREF (hash_tables, i)); +} + +void +init_pdumper_once (void) +{ + pdumper_do_now_and_after_load (thaw_hash_tables); +} void syms_of_pdumper (void) diff --git a/src/pdumper.h b/src/pdumper.h index 6a99b511f2f..c793fb40580 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -256,6 +256,7 @@ pdumper_clear_marks (void) file was loaded. */ extern void pdumper_record_wd (const char *); +void init_pdumper_once (void); void syms_of_pdumper (void); INLINE_HEADER_END diff --git a/src/search.c b/src/search.c index 38c64caf7c0..6fb3716cd43 100644 --- a/src/search.c +++ b/src/search.c @@ -3271,7 +3271,7 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) TYPE_MAXIMUM (ptrdiff_t), &nl_count_cache, NULL, true); /* Create vector and populate it. */ - cache_newlines = make_uninit_vector (nl_count_cache); + cache_newlines = make_vector (nl_count_cache, make_fixnum (-1)); if (nl_count_cache) { @@ -3285,15 +3285,12 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) break; ASET (cache_newlines, i, make_fixnum (found - 1)); } - /* Fill the rest of slots with an invalid position. */ - for ( ; i < nl_count_cache; i++) - ASET (cache_newlines, i, make_fixnum (-1)); } /* Now do the same, but without using the cache. */ find_newline1 (BEGV, BEGV_BYTE, ZV, ZV_BYTE, TYPE_MAXIMUM (ptrdiff_t), &nl_count_buf, NULL, true); - buf_newlines = make_uninit_vector (nl_count_buf); + buf_newlines = make_vector (nl_count_buf, make_fixnum (-1)); if (nl_count_buf) { for (from = BEGV, found = from, i = 0; from < ZV; from = found, i++) @@ -3306,14 +3303,10 @@ the buffer. If the buffer doesn't have a cache, the value is nil. */) break; ASET (buf_newlines, i, make_fixnum (found - 1)); } - for ( ; i < nl_count_buf; i++) - ASET (buf_newlines, i, make_fixnum (-1)); } /* Construct the value and return it. */ - val = make_uninit_vector (2); - ASET (val, 0, cache_newlines); - ASET (val, 1, buf_newlines); + val = CALLN (Fvector, cache_newlines, buf_newlines); if (old != NULL) set_buffer_internal_1 (old); diff --git a/src/syntax.c b/src/syntax.c index a03202d386c..9f77ea5f9b0 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3617,9 +3617,9 @@ init_syntax_once (void) DEFSYM (Qsyntax_table, "syntax-table"); /* Create objects which can be shared among syntax tables. */ - Vsyntax_code_object = make_uninit_vector (Smax); + Vsyntax_code_object = make_nil_vector (Smax); for (i = 0; i < Smax; i++) - ASET (Vsyntax_code_object, i, Fcons (make_fixnum (i), Qnil)); + ASET (Vsyntax_code_object, i, list1 (make_fixnum (i))); /* Now we are ready to set up this property, so we can create syntax tables. */ diff --git a/src/sysdep.c b/src/sysdep.c index 6b54ed3b6ec..a1050c4309a 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -49,10 +49,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # include <cygwin/fs.h> #endif -#if defined DARWIN_OS || defined __FreeBSD__ +#if defined DARWIN_OS || defined __FreeBSD__ || defined __OpenBSD__ # include <sys/sysctl.h> #endif +#ifdef DARWIN_OS +# include <libproc.h> +#endif + #ifdef __FreeBSD__ /* Sparc/ARM machine/frame.h has 'struct frame' which conflicts with Emacs's 'struct frame', so rename it. */ @@ -3061,37 +3065,43 @@ list_system_processes (void) return proclist; } -#elif defined DARWIN_OS || defined __FreeBSD__ +#elif defined DARWIN_OS || defined __FreeBSD__ || defined __OpenBSD__ Lisp_Object list_system_processes (void) { #ifdef DARWIN_OS int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL}; +#elif defined __OpenBSD__ + int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_ALL, 0, + sizeof (struct kinfo_proc), 4096}; #else int mib[] = {CTL_KERN, KERN_PROC, KERN_PROC_PROC}; #endif size_t len; + size_t mibsize = sizeof mib / sizeof mib[0]; struct kinfo_proc *procs; size_t i; Lisp_Object proclist = Qnil; - if (sysctl (mib, 3, NULL, &len, NULL, 0) != 0 || len == 0) + if (sysctl (mib, mibsize, NULL, &len, NULL, 0) != 0 || len == 0) return proclist; procs = xmalloc (len); - if (sysctl (mib, 3, procs, &len, NULL, 0) != 0 || len == 0) + if (sysctl (mib, mibsize, procs, &len, NULL, 0) != 0 || len == 0) { xfree (procs); return proclist; } - len /= sizeof (struct kinfo_proc); + len /= sizeof procs[0]; for (i = 0; i < len; i++) { #ifdef DARWIN_OS proclist = Fcons (INT_TO_INTEGER (procs[i].kp_proc.p_pid), proclist); +#elif defined __OpenBSD__ + proclist = Fcons (INT_TO_INTEGER (procs[i].p_pid), proclist); #else proclist = Fcons (INT_TO_INTEGER (procs[i].ki_pid), proclist); #endif @@ -3865,8 +3875,21 @@ system_process_attributes (Lisp_Object pid) if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); + char pathbuf[PROC_PIDPATHINFO_MAXSIZE]; + char *comm; + + if (proc_pidpath (proc_id, pathbuf, sizeof(pathbuf)) > 0) + { + if ((comm = strrchr (pathbuf, '/'))) + comm++; + else + comm = pathbuf; + } + else + comm = proc.kp_proc.p_comm; + decoded_comm = (code_convert_string_norecord - (build_unibyte_string (proc.kp_proc.p_comm), + (build_unibyte_string (comm), Vlocale_coding_system, 0)); attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs); diff --git a/src/timefns.c b/src/timefns.c index 7bcc37d7c1e..71d5e10872a 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -1312,11 +1312,12 @@ or (if you need time as a string) `format-time-string'. */) ((size_t) -1) for MAXSIZE. This function behaves like nstrftime, except it allows NUL - bytes in FORMAT and it does not support nanoseconds. */ + bytes in FORMAT. */ static size_t emacs_nmemftime (char *s, size_t maxsize, const char *format, size_t format_len, const struct tm *tp, timezone_t tz, int ns) { + int saved_errno = errno; size_t total = 0; /* Loop through all the NUL-terminated strings in the format @@ -1326,30 +1327,25 @@ emacs_nmemftime (char *s, size_t maxsize, const char *format, '\0' byte so we must invoke it separately for each such string. */ for (;;) { - size_t len; - size_t result; - + errno = 0; + size_t result = nstrftime (s, maxsize, format, tp, tz, ns); + if (result == 0 && errno != 0) + return result; if (s) - s[0] = '\1'; - - result = nstrftime (s, maxsize, format, tp, tz, ns); - - if (s) - { - if (result == 0 && s[0] != '\0') - return 0; - s += result + 1; - } + s += result + 1; maxsize -= result + 1; total += result; - len = strlen (format); + size_t len = strlen (format); if (len == format_len) - return total; + break; total++; format += len + 1; format_len -= len + 1; } + + errno = saved_errno; + return total; } static Lisp_Object @@ -1379,10 +1375,11 @@ format_time_string (char const *format, ptrdiff_t formatlen, while (true) { - buf[0] = '\1'; + errno = 0; len = emacs_nmemftime (buf, size, format, formatlen, tmp, tz, ns); - if ((0 < len && len < size) || (len == 0 && buf[0] == '\0')) + if (len != 0 || errno == 0) break; + eassert (errno == ERANGE); /* Buffer was too small, so make it bigger and try again. */ len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tmp, tz, ns); @@ -2048,7 +2045,7 @@ syms_of_timefns (void) defsubr (&Scurrent_time_zone); defsubr (&Sset_time_zone_rule); - flt_radix_power = make_vector (flt_radix_power_size, Qnil); + flt_radix_power = make_nil_vector (flt_radix_power_size); staticpro (&flt_radix_power); #ifdef NEED_ZTRILLION_INIT diff --git a/src/window.c b/src/window.c index e2dea8b70ef..ef58f43a0bd 100644 --- a/src/window.c +++ b/src/window.c @@ -7465,7 +7465,7 @@ saved by this function. */) data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window : Qnil; data->root_window = FRAME_ROOT_WINDOW (f); data->focus_frame = FRAME_FOCUS_FRAME (f); - Lisp_Object tem = make_uninit_vector (n_windows); + Lisp_Object tem = make_nil_vector (n_windows); data->saved_windows = tem; for (ptrdiff_t i = 0; i < n_windows; i++) ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window))); diff --git a/src/xdisp.c b/src/xdisp.c index 4fe1c4288af..ad03ac46054 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -180,8 +180,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ present (non-empty) only if the corresponding display margin is shown in the window. If the glyph array for a marginal area is not present its beginning and end coincide, i.e. such arrays are - actually empty (they contain no glyphs). Frame glyph matrics, used - on text-mode terminals (see below) never have marginal areas, they + actually empty (they contain no glyphs). Frame glyph matrices, used + on text-mode terminals (see below) never have marginal areas; they treat the entire frame-wide row of glyphs as a single large "text area". @@ -7555,7 +7555,7 @@ get_next_display_element (struct it *it) /* Merge `nobreak-space' into the current face. */ face_id = merge_faces (it->w, Qnobreak_space, 0, it->face_id); - XSETINT (it->ctl_chars[0], ' '); + XSETINT (it->ctl_chars[0], it->c); ctl_len = 1; goto display_control; } @@ -7568,7 +7568,7 @@ get_next_display_element (struct it *it) /* Merge `nobreak-space' into the current face. */ face_id = merge_faces (it->w, Qnobreak_hyphen, 0, it->face_id); - XSETINT (it->ctl_chars[0], '-'); + XSETINT (it->ctl_chars[0], it->c); ctl_len = 1; goto display_control; } diff --git a/src/xfaces.c b/src/xfaces.c index 585cfa1cf4a..06d2f994de6 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1572,22 +1572,18 @@ the face font sort order. */) for (i = nfonts - 1; i >= 0; --i) { Lisp_Object font = AREF (vec, i); - Lisp_Object v = make_uninit_vector (8); - int point; - Lisp_Object spacing; - - ASET (v, 0, AREF (font, FONT_FAMILY_INDEX)); - ASET (v, 1, FONT_WIDTH_SYMBOLIC (font)); - point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10, - FRAME_RES_Y (f)); - ASET (v, 2, make_fixnum (point)); - ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font)); - ASET (v, 4, FONT_SLANT_SYMBOLIC (font)); - spacing = Ffont_get (font, QCspacing); - ASET (v, 5, (NILP (spacing) || EQ (spacing, Qp)) ? Qnil : Qt); - ASET (v, 6, Ffont_xlfd_name (font, Qnil)); - ASET (v, 7, AREF (font, FONT_REGISTRY_INDEX)); - + int point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10, + FRAME_RES_Y (f)); + Lisp_Object spacing = Ffont_get (font, QCspacing); + Lisp_Object v = CALLN (Fvector, + AREF (font, FONT_FAMILY_INDEX), + FONT_WIDTH_SYMBOLIC (font), + make_fixnum (point), + FONT_WEIGHT_SYMBOLIC (font), + FONT_SLANT_SYMBOLIC (font), + NILP (spacing) || EQ (spacing, Qp) ? Qnil : Qt, + Ffont_xlfd_name (font, Qnil), + AREF (font, FONT_REGISTRY_INDEX)); result = Fcons (v, result); } @@ -2517,6 +2513,7 @@ merge_face_ref (struct window *w, { bool ok = true; /* Succeed without an error? */ Lisp_Object filtered_face_ref; + bool attr_filter_passed = false; filtered_face_ref = face_ref; do @@ -2613,6 +2610,7 @@ merge_face_ref (struct window *w, || UNSPECIFIEDP (scratch_attrs[attr_filter])) return true; } + attr_filter_passed = true; } while (CONSP (face_ref) && CONSP (XCDR (face_ref))) { @@ -2776,9 +2774,21 @@ merge_face_ref (struct window *w, { /* This is not really very useful; it's just like a normal face reference. */ - if (! merge_face_ref (w, f, value, to, - err_msgs, named_merge_points, - attr_filter)) + if (attr_filter_passed) + { + /* We already know that this face was tested + against attr_filter and was found applicable, + so don't pass attr_filter to merge_face_ref. + This is for when a face is specified like + (:inherit FACE :extend t), but the parent + FACE itself doesn't specify :extend. */ + if (! merge_face_ref (w, f, value, to, + err_msgs, named_merge_points, 0)) + err = true; + } + else if (! merge_face_ref (w, f, value, to, + err_msgs, named_merge_points, + attr_filter)) err = true; } else if (EQ (keyword, QCextend)) diff --git a/src/xfns.c b/src/xfns.c index 09dcbbfb92d..78f977bf0aa 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5890,7 +5890,8 @@ If WINDOW-ID is non-nil, change the property of that window instead elsize = element_format == 32 ? sizeof (long) : element_format >> 3; data = xnmalloc (nelements, elsize); - x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format); + x_fill_property_data (FRAME_X_DISPLAY (f), value, data, nelements, + element_format); } else { @@ -6196,10 +6197,10 @@ Otherwise, the return value is a vector with the following fields: { XFree (tmp_data); - prop_attr = make_uninit_vector (3); - ASET (prop_attr, 0, make_fixnum (actual_type)); - ASET (prop_attr, 1, make_fixnum (actual_format)); - ASET (prop_attr, 2, make_fixnum (bytes_remaining / (actual_format >> 3))); + prop_attr = CALLN (Fvector, + make_fixnum (actual_type), + make_fixnum (actual_format), + make_fixnum (bytes_remaining / (actual_format >> 3))); } unblock_input (); @@ -8027,7 +8028,7 @@ If this equals the symbol 'resize-mode', Emacs uses GTK's resize mode to always trigger an immediate resize of the child frame. This method is deprecated by GTK and may not work in future versions of that toolkit. It also may freeze Emacs when used with other desktop environments. It -avoids, however, the unpleasent flicker induced by the hiding approach. +avoids, however, the unpleasant flicker induced by the hiding approach. This variable is considered a temporary workaround and will be hopefully eliminated in future versions of Emacs. */); diff --git a/src/xrdb.c b/src/xrdb.c index e3a1fcb15a9..3d7f715c88f 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -289,9 +289,9 @@ get_user_app (const char *class) /* Check in the home directory. This is a bit of a hack; let's hope one's home directory doesn't contain ':' or '%'. */ char const *home = get_homedir (); - db = search_magic_path (home, class, "%L/%N"); + db = search_magic_path (home, class, "/%L/%N"); if (! db) - db = search_magic_path (home, class, "%N"); + db = search_magic_path (home, class, "/%N"); } return db; diff --git a/src/xselect.c b/src/xselect.c index 48d6215a7bb..383aebf96c8 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -1594,7 +1594,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, return x_atom_to_symbol (dpyinfo, (Atom) idata[0]); else { - Lisp_Object v = make_uninit_vector (size / sizeof (int)); + Lisp_Object v = make_nil_vector (size / sizeof (int)); for (i = 0; i < size / sizeof (int); i++) ASET (v, i, x_atom_to_symbol (dpyinfo, (Atom) idata[i])); @@ -1653,7 +1653,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo, else { ptrdiff_t i; - Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE); + Lisp_Object v = make_nil_vector (size / X_LONG_SIZE); if (type == XA_INTEGER) { @@ -1860,7 +1860,7 @@ clean_local_selection_data (Lisp_Object obj) Lisp_Object copy; if (size == 1) return clean_local_selection_data (AREF (obj, 0)); - copy = make_uninit_vector (size); + copy = make_nil_vector (size); for (i = 0; i < size; i++) ASET (copy, i, clean_local_selection_data (AREF (obj, i))); return copy; @@ -2276,23 +2276,28 @@ x_check_property_data (Lisp_Object data) DPY is the display use to look up X atoms. DATA is a Lisp list of values to be converted. - RET is the C array that contains the converted values. It is assumed - it is big enough to hold all values. + RET is the C array that contains the converted values. + NELEMENTS_MAX is the number of values that will fit in RET. + Any excess values in DATA are ignored. FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to be stored in RET. Note that long is used for 32 even if long is more than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and XClientMessageEvent). */ void -x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format) +x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, + int nelements_max, int format) { unsigned long val; unsigned long *d32 = (unsigned long *) ret; unsigned short *d16 = (unsigned short *) ret; unsigned char *d08 = (unsigned char *) ret; + int nelements; Lisp_Object iter; - for (iter = data; CONSP (iter); iter = XCDR (iter)) + for (iter = data, nelements = 0; + CONSP (iter) && nelements < nelements_max; + iter = XCDR (iter), nelements++) { Lisp_Object o = XCAR (iter); @@ -2593,7 +2598,9 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest; memset (event.xclient.data.l, 0, sizeof (event.xclient.data.l)); + /* event.xclient.data can hold 20 chars, 10 shorts, or 5 longs. */ x_fill_property_data (dpyinfo->display, values, event.xclient.data.b, + 5 * 32 / event.xclient.format, event.xclient.format); /* If event mask is 0 the event is sent to the client that created diff --git a/src/xterm.c b/src/xterm.c index 6340700cb89..2e0407aff40 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8760,6 +8760,20 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case FocusIn: + /* Some WMs (e.g. Mutter in Gnome Shell), don't unmap + minimized/iconified windows; thus, for those WMs we won't get + a MapNotify when unminimizing/deconifying. Check here if we + are deconizing a window (Bug42655). */ + f = any; + if (f && FRAME_ICONIFIED_P (f)) + { + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, false); + f->output_data.x->has_been_visible = true; + inev.ie.kind = DEICONIFY_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + } + x_detect_focus_change (dpyinfo, any, event, &inev.ie); goto OTHER; @@ -9907,6 +9921,13 @@ x_uncatch_errors (void) { struct x_error_message_stack *tmp; + /* In rare situations when running Emacs run in daemon mode, + shutting down an emacsclient via delete-frame can cause + x_uncatch_errors to be called when x_error_message is set to + NULL. */ + if (x_error_message == NULL) + return; + block_input (); /* The display may have been closed before this function is called. diff --git a/src/xterm.h b/src/xterm.h index bc10043c54c..db8d5847814 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1207,6 +1207,7 @@ extern int x_check_property_data (Lisp_Object); extern void x_fill_property_data (Display *, Lisp_Object, void *, + int, int); extern Lisp_Object x_property_data_to_lisp (struct frame *, const unsigned char *, diff --git a/src/xwidget.c b/src/xwidget.c index 0347f1e6483..154b3e9c82c 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -23,13 +23,21 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" #include "blockinput.h" +#include "dispextern.h" #include "frame.h" #include "keyboard.h" #include "gtkutil.h" #include "sysstdio.h" +#include "termhooks.h" +#include "window.h" +/* Include xwidget bottom end headers. */ +#ifdef USE_GTK #include <webkit2/webkit2.h> #include <JavaScriptCore/JavaScript.h> +#elif defined NS_IMPL_COCOA +#include "nsxwidget.h" +#endif static struct xwidget * allocate_xwidget (void) @@ -48,6 +56,7 @@ allocate_xwidget_view (void) static struct xwidget_view *xwidget_view_lookup (struct xwidget *, struct window *); +#ifdef USE_GTK static void webkit_view_load_changed_cb (WebKitWebView *, WebKitLoadEvent, gpointer); @@ -61,6 +70,7 @@ webkit_decide_policy_cb (WebKitWebView *, WebKitPolicyDecision *, WebKitPolicyDecisionType, gpointer); +#endif DEFUN ("make-xwidget", @@ -78,8 +88,10 @@ Returns the newly constructed xwidget, or nil if construction fails. */) Lisp_Object title, Lisp_Object width, Lisp_Object height, Lisp_Object arguments, Lisp_Object buffer) { +#ifdef USE_GTK if (!xg_gtk_initialized) error ("make-xwidget: GTK has not been initialized"); +#endif CHECK_SYMBOL (type); CHECK_FIXNAT (width); CHECK_FIXNAT (height); @@ -94,10 +106,11 @@ Returns the newly constructed xwidget, or nil if construction fails. */) xw->kill_without_query = false; XSETXWIDGET (val, xw); Vxwidget_list = Fcons (val, Vxwidget_list); - xw->widgetwindow_osr = NULL; - xw->widget_osr = NULL; xw->plist = Qnil; +#ifdef USE_GTK + xw->widgetwindow_osr = NULL; + xw->widget_osr = NULL; if (EQ (xw->type, Qwebkit)) { block_input (); @@ -152,6 +165,9 @@ Returns the newly constructed xwidget, or nil if construction fails. */) unblock_input (); } +#elif defined NS_IMPL_COCOA + nsxwidget_init (xw); +#endif return val; } @@ -187,6 +203,7 @@ xwidget_hidden (struct xwidget_view *xv) return xv->hidden; } +#ifdef USE_GTK static void xwidget_show_view (struct xwidget_view *xv) { @@ -220,13 +237,14 @@ offscreen_damage_event (GtkWidget *widget, GdkEvent *event, if (GTK_IS_WIDGET (xv_widget)) gtk_widget_queue_draw (GTK_WIDGET (xv_widget)); else - printf ("Warning, offscreen_damage_event received invalid xv pointer:%p\n", - xv_widget); + message ("Warning, offscreen_damage_event received invalid xv pointer:%p\n", + xv_widget); return FALSE; } +#endif /* USE_GTK */ -static void +void store_xwidget_event_string (struct xwidget *xw, const char *eventname, const char *eventstr) { @@ -240,7 +258,27 @@ store_xwidget_event_string (struct xwidget *xw, const char *eventname, kbd_buffer_store_event (&event); } -static void +void +store_xwidget_download_callback_event (struct xwidget *xw, + const char *url, + const char *mimetype, + const char *filename) +{ + struct input_event event; + Lisp_Object xwl; + XSETXWIDGET (xwl, xw); + EVENT_INIT (event); + event.kind = XWIDGET_EVENT; + event.frame_or_window = Qnil; + event.arg = list5 (intern ("download-callback"), + xwl, + build_string (url), + build_string (mimetype), + build_string (filename)); + kbd_buffer_store_event (&event); +} + +void store_xwidget_js_callback_event (struct xwidget *xw, Lisp_Object proc, Lisp_Object argument) @@ -256,6 +294,7 @@ store_xwidget_js_callback_event (struct xwidget *xw, } +#ifdef USE_GTK void webkit_view_load_changed_cb (WebKitWebView *webkitwebview, WebKitLoadEvent load_event, @@ -304,7 +343,7 @@ webkit_js_to_lisp (JSCValue *value) memory_full (SIZE_MAX); ptrdiff_t n = dlen; - struct Lisp_Vector *p = allocate_vector (n); + struct Lisp_Vector *p = allocate_nil_vector (n); for (ptrdiff_t i = 0; i < n; ++i) { @@ -322,7 +361,7 @@ webkit_js_to_lisp (JSCValue *value) Lisp_Object obj; if (PTRDIFF_MAX < n) memory_full (n); - struct Lisp_Vector *p = allocate_vector (n); + struct Lisp_Vector *p = allocate_nil_vector (n); for (ptrdiff_t i = 0; i < n; ++i) { @@ -486,6 +525,7 @@ xwidget_osr_event_set_embedder (GtkWidget *widget, GdkEvent *event, gtk_widget_get_window (xv->widget)); return FALSE; } +#endif /* USE_GTK */ /* Initializes and does initial placement of an xwidget view on screen. */ @@ -495,8 +535,10 @@ xwidget_init_view (struct xwidget *xww, int x, int y) { +#ifdef USE_GTK if (!xg_gtk_initialized) error ("xwidget_init_view: GTK has not been initialized"); +#endif struct xwidget_view *xv = allocate_xwidget_view (); Lisp_Object val; @@ -507,6 +549,7 @@ xwidget_init_view (struct xwidget *xww, XSETWINDOW (xv->w, s->w); XSETXWIDGET (xv->model, xww); +#ifdef USE_GTK if (EQ (xww->type, Qwebkit)) { xv->widget = gtk_drawing_area_new (); @@ -564,6 +607,10 @@ xwidget_init_view (struct xwidget *xww, xv->x = x; xv->y = y; gtk_widget_show_all (xv->widgetwindow); +#elif defined NS_IMPL_COCOA + nsxwidget_init_view (xv, xww, s, x, y); + nsxwidget_resize_view(xv, xww->width, xww->height); +#endif return xv; } @@ -576,6 +623,7 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) initialization. */ struct xwidget *xww = s->xwidget; struct xwidget_view *xv = xwidget_view_lookup (xww, s->w); + int text_area_x, text_area_y, text_area_width, text_area_height; int clip_right; int clip_bottom; int clip_top; @@ -587,13 +635,47 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) /* Do initialization here in the display loop because there is no other time to know things like window placement etc. Do not create a new view if we have found one that is usable. */ +#ifdef USE_GTK if (!xv) xv = xwidget_init_view (xww, s, x, y); - - int text_area_x, text_area_y, text_area_width, text_area_height; +#elif defined NS_IMPL_COCOA + if (!xv) + { + /* Enforce 1 to 1, model and view for macOS Cocoa webkit2. */ + if (xww->xv) + { + if (xwidget_hidden (xww->xv)) + { + Lisp_Object xvl; + XSETXWIDGET_VIEW (xvl, xww->xv); + Fdelete_xwidget_view (xvl); + } + else + { + message ("You can't share an xwidget (webkit2) among windows."); + return; + } + } + xv = xwidget_init_view (xww, s, x, y); + } +#endif window_box (s->w, TEXT_AREA, &text_area_x, &text_area_y, &text_area_width, &text_area_height); + + /* Resize xwidget webkit if its container window size is changed in + some ways, for example, a buffer became hidden in small split + window, then it can appear front in merged whole window. */ + if (EQ (xww->type, Qwebkit) + && (xww->width != text_area_width || xww->height != text_area_height)) + { + Lisp_Object xwl; + XSETXWIDGET (xwl, xww); + Fxwidget_resize (xwl, + make_int (text_area_width), + make_int (text_area_height)); + } + clip_left = max (0, text_area_x - x); clip_right = max (clip_left, min (xww->width, text_area_x + text_area_width - x)); @@ -616,8 +698,14 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) /* Has it moved? */ if (moved) - gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)), - xv->widgetwindow, x + clip_left, y + clip_top); + { +#ifdef USE_GTK + gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)), + xv->widgetwindow, x + clip_left, y + clip_top); +#elif defined NS_IMPL_COCOA + nsxwidget_move_view (xv, x + clip_left, y + clip_top); +#endif + } /* Clip the widget window if some parts happen to be outside drawable area. An Emacs window is not a gtk window. A gtk window @@ -628,10 +716,16 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) || xv->clip_bottom != clip_bottom || xv->clip_top != clip_top || xv->clip_left != clip_left) { +#ifdef USE_GTK gtk_widget_set_size_request (xv->widgetwindow, clip_right - clip_left, clip_bottom - clip_top); gtk_fixed_move (GTK_FIXED (xv->widgetwindow), xv->widget, -clip_left, -clip_top); +#elif defined NS_IMPL_COCOA + nsxwidget_resize_view (xv, clip_right - clip_left, + clip_bottom - clip_top); + nsxwidget_move_widget_in_view (xv, -clip_left, -clip_top); +#endif xv->clip_right = clip_right; xv->clip_bottom = clip_bottom; @@ -645,22 +739,66 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) xwidgets background. It's just a visual glitch though. */ if (!xwidget_hidden (xv)) { +#ifdef USE_GTK gtk_widget_queue_draw (xv->widgetwindow); gtk_widget_queue_draw (xv->widget); +#elif defined NS_IMPL_COCOA + nsxwidget_set_needsdisplay (xv); +#endif } } -/* Macro that checks WEBKIT_IS_WEB_VIEW (xw->widget_osr) first. */ +static bool +xwidget_is_web_view (struct xwidget *xw) +{ +#ifdef USE_GTK + return xw->widget_osr != NULL && WEBKIT_IS_WEB_VIEW (xw->widget_osr); +#elif defined NS_IMPL_COCOA + return nsxwidget_is_web_view (xw); +#endif +} + +/* Macro that checks xwidget hold webkit web view first. */ #define WEBKIT_FN_INIT() \ CHECK_XWIDGET (xwidget); \ struct xwidget *xw = XXWIDGET (xwidget); \ - if (!xw->widget_osr || !WEBKIT_IS_WEB_VIEW (xw->widget_osr)) \ + if (!xwidget_is_web_view (xw)) \ { \ fputs ("ERROR xw->widget_osr does not hold a webkit instance\n", \ stdout); \ return Qnil; \ } +DEFUN ("xwidget-webkit-uri", + Fxwidget_webkit_uri, Sxwidget_webkit_uri, + 1, 1, 0, + doc: /* Get the current URL of XWIDGET webkit. */) + (Lisp_Object xwidget) +{ + WEBKIT_FN_INIT (); +#ifdef USE_GTK + WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); + return build_string (webkit_web_view_get_uri (wkwv)); +#elif defined NS_IMPL_COCOA + return nsxwidget_webkit_uri (xw); +#endif +} + +DEFUN ("xwidget-webkit-title", + Fxwidget_webkit_title, Sxwidget_webkit_title, + 1, 1, 0, + doc: /* Get the current title of XWIDGET webkit. */) + (Lisp_Object xwidget) +{ + WEBKIT_FN_INIT (); +#ifdef USE_GTK + WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); + return build_string (webkit_web_view_get_title (wkwv)); +#elif defined NS_IMPL_COCOA + return nsxwidget_webkit_title (xw); +#endif +} + DEFUN ("xwidget-webkit-goto-uri", Fxwidget_webkit_goto_uri, Sxwidget_webkit_goto_uri, 2, 2, 0, @@ -670,7 +808,36 @@ DEFUN ("xwidget-webkit-goto-uri", WEBKIT_FN_INIT (); CHECK_STRING (uri); uri = ENCODE_FILE (uri); +#ifdef USE_GTK webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), SSDATA (uri)); +#elif defined NS_IMPL_COCOA + nsxwidget_webkit_goto_uri (xw, SSDATA (uri)); +#endif + return Qnil; +} + +DEFUN ("xwidget-webkit-goto-history", + Fxwidget_webkit_goto_history, Sxwidget_webkit_goto_history, + 2, 2, 0, + doc: /* Make the XWIDGET webkit load REL-POS (-1, 0, 1) page in browse history. */) + (Lisp_Object xwidget, Lisp_Object rel_pos) +{ + WEBKIT_FN_INIT (); + /* Should be one of -1, 0, 1 */ + if (XFIXNUM (rel_pos) < -1 || XFIXNUM (rel_pos) > 1) + args_out_of_range_3 (rel_pos, make_fixnum (-1), make_fixnum (1)); + +#ifdef USE_GTK + WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); + switch (XFIXNAT (rel_pos)) + { + case -1: webkit_web_view_go_back (wkwv); break; + case 0: webkit_web_view_reload (wkwv); break; + case 1: webkit_web_view_go_forward (wkwv); break; + } +#elif defined NS_IMPL_COCOA + nsxwidget_webkit_goto_history (xw, XFIXNAT (rel_pos)); +#endif return Qnil; } @@ -684,14 +851,19 @@ DEFUN ("xwidget-webkit-zoom", if (FLOATP (factor)) { double zoom_change = XFLOAT_DATA (factor); +#ifdef USE_GTK webkit_web_view_set_zoom_level (WEBKIT_WEB_VIEW (xw->widget_osr), webkit_web_view_get_zoom_level (WEBKIT_WEB_VIEW (xw->widget_osr)) + zoom_change); +#elif defined NS_IMPL_COCOA + nsxwidget_webkit_zoom (xw, zoom_change); +#endif } return Qnil; } +#ifdef USE_GTK /* Save script and fun in the script/callback save vector and return its index. */ static ptrdiff_t @@ -713,6 +885,7 @@ save_script_callback (struct xwidget *xw, Lisp_Object script, Lisp_Object fun) ASET (cbs, idx, Fcons (make_mint_ptr (xlispstrdup (script)), fun)); return idx; } +#endif DEFUN ("xwidget-webkit-execute-script", Fxwidget_webkit_execute_script, Sxwidget_webkit_execute_script, @@ -729,6 +902,7 @@ argument procedure FUN.*/) script = ENCODE_SYSTEM (script); +#ifdef USE_GTK /* Protect script and fun during GC. */ intptr_t idx = save_script_callback (xw, script, fun); @@ -742,6 +916,9 @@ argument procedure FUN.*/) NULL, /* cancelable */ webkit_javascript_finished_cb, (gpointer) idx); +#elif defined NS_IMPL_COCOA + nsxwidget_webkit_execute_script (xw, SSDATA (script), fun); +#endif return Qnil; } @@ -758,6 +935,7 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, xw->height = h; /* If there is an offscreen widget resize it first. */ +#ifdef USE_GTK if (xw->widget_osr) { gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, @@ -766,6 +944,9 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, xw->height); } +#elif defined NS_IMPL_COCOA + nsxwidget_resize (xw); +#endif for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail)) { @@ -773,8 +954,14 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, { struct xwidget_view *xv = XXWIDGET_VIEW (XCAR (tail)); if (XXWIDGET (xv->model) == xw) + { +#ifdef USE_GTK gtk_widget_set_size_request (GTK_WIDGET (xv->widget), xw->width, xw->height); +#elif defined NS_IMPL_COCOA + nsxwidget_resize_view(xv, xw->width, xw->height); +#endif + } } } @@ -793,9 +980,13 @@ Emacs allocated area accordingly. */) (Lisp_Object xwidget) { CHECK_XWIDGET (xwidget); +#ifdef USE_GTK GtkRequisition requisition; gtk_widget_size_request (XXWIDGET (xwidget)->widget_osr, &requisition); return list2i (requisition.width, requisition.height); +#elif defined NS_IMPL_COCOA + return nsxwidget_get_size (XXWIDGET (xwidget)); +#endif } DEFUN ("xwidgetp", @@ -872,14 +1063,19 @@ DEFUN ("delete-xwidget-view", { CHECK_XWIDGET_VIEW (xwidget_view); struct xwidget_view *xv = XXWIDGET_VIEW (xwidget_view); +#ifdef USE_GTK gtk_widget_destroy (xv->widgetwindow); - Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list); /* xv->model still has signals pointing to the view. There can be several views. Find the matching signals and delete them all. */ g_signal_handlers_disconnect_matched (XXWIDGET (xv->model)->widgetwindow_osr, G_SIGNAL_MATCH_DATA, 0, 0, 0, 0, xv->widget); +#elif defined NS_IMPL_COCOA + nsxwidget_delete_view (xv); +#endif + + Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list); return Qnil; } @@ -985,7 +1181,10 @@ syms_of_xwidget (void) defsubr (&Sxwidget_query_on_exit_flag); defsubr (&Sset_xwidget_query_on_exit_flag); + defsubr (&Sxwidget_webkit_uri); + defsubr (&Sxwidget_webkit_title); defsubr (&Sxwidget_webkit_goto_uri); + defsubr (&Sxwidget_webkit_goto_history); defsubr (&Sxwidget_webkit_zoom); defsubr (&Sxwidget_webkit_execute_script); DEFSYM (Qwebkit, "webkit"); @@ -1156,11 +1355,19 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix) xwidget_end_redisplay (w->current_matrix); */ struct xwidget_view *xv = xwidget_view_lookup (glyph->u.xwidget, w); +#ifdef USE_GTK /* FIXME: Is it safe to assume xwidget_view_lookup always succeeds here? If so, this comment can be removed. If not, the code probably needs fixing. */ eassume (xv); xwidget_touch (xv); +#elif defined NS_IMPL_COCOA + /* In NS xwidget, xv can be NULL for the second or + later views for a model, the result of 1 to 1 + model view relation enforcement. */ + if (xv) + xwidget_touch (xv); +#endif } } } @@ -1177,9 +1384,21 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix) if (XWINDOW (xv->w) == w) { if (xwidget_touched (xv)) - xwidget_show_view (xv); + { +#ifdef USE_GTK + xwidget_show_view (xv); +#elif defined NS_IMPL_COCOA + nsxwidget_show_view (xv); +#endif + } else - xwidget_hide_view (xv); + { +#ifdef USE_GTK + xwidget_hide_view (xv); +#elif defined NS_IMPL_COCOA + nsxwidget_hide_view (xv); +#endif + } } } } @@ -1198,6 +1417,7 @@ kill_buffer_xwidgets (Lisp_Object buffer) { CHECK_XWIDGET (xwidget); struct xwidget *xw = XXWIDGET (xwidget); +#ifdef USE_GTK if (xw->widget_osr && xw->widgetwindow_osr) { gtk_widget_destroy (xw->widget_osr); @@ -1211,6 +1431,9 @@ kill_buffer_xwidgets (Lisp_Object buffer) xfree (xmint_pointer (XCAR (cb))); ASET (xw->script_callbacks, idx, Qnil); } +#elif defined NS_IMPL_COCOA + nsxwidget_kill (xw); +#endif } } } diff --git a/src/xwidget.h b/src/xwidget.h index 99fa8bbd612..40ad8ae8334 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -29,7 +29,13 @@ struct xwidget_view; struct window; #ifdef HAVE_XWIDGETS -# include <gtk/gtk.h> + +#if defined (USE_GTK) +#include <gtk/gtk.h> +#elif defined (NS_IMPL_COCOA) && defined (__OBJC__) +#import <AppKit/NSView.h> +#import "nsxwidget.h" +#endif struct xwidget { @@ -54,9 +60,25 @@ struct xwidget int height; int width; +#if defined (USE_GTK) /* For offscreen widgets, unused if not osr. */ GtkWidget *widget_osr; GtkWidget *widgetwindow_osr; +#elif defined (NS_IMPL_COCOA) +# ifdef __OBJC__ + /* For offscreen widgets, unused if not osr. */ + NSView *xwWidget; + XwWindow *xwWindow; + + /* Used only for xwidget types (such as webkit2) enforcing 1 to 1 + relationship between model and view. */ + struct xwidget_view *xv; +# else + void *xwWidget; + void *xwWindow; + struct xwidget_view *xv; +# endif +#endif /* Kill silently if Emacs is exited. */ bool_bf kill_without_query : 1; @@ -75,9 +97,20 @@ struct xwidget_view /* The "live" instance isn't drawn. */ bool hidden; +#if defined (USE_GTK) GtkWidget *widget; GtkWidget *widgetwindow; GtkWidget *emacswindow; +#elif defined (NS_IMPL_COCOA) +# ifdef __OBJC__ + XvWindow *xvWindow; + NSView *emacswindow; +# else + void *xvWindow; + void *emacswindow; +# endif +#endif + int x; int y; int clip_right; @@ -116,6 +149,19 @@ void x_draw_xwidget_glyph_string (struct glyph_string *); struct xwidget *lookup_xwidget (Lisp_Object spec); void xwidget_end_redisplay (struct window *, struct glyph_matrix *); void kill_buffer_xwidgets (Lisp_Object); +/* Defined in 'xwidget.c'. */ +void store_xwidget_event_string (struct xwidget *xw, + const char *eventname, + const char *eventstr); + +void store_xwidget_download_callback_event (struct xwidget *xw, + const char *url, + const char *mimetype, + const char *filename); + +void store_xwidget_js_callback_event (struct xwidget *xw, + Lisp_Object proc, + Lisp_Object argument); #else INLINE_HEADER_BEGIN INLINE void syms_of_xwidget (void) {} diff --git a/test/lisp/bookmark-resources/test-list.bmk b/test/lisp/bookmark-resources/test-list.bmk new file mode 100644 index 00000000000..696d64979b8 --- /dev/null +++ b/test/lisp/bookmark-resources/test-list.bmk @@ -0,0 +1,20 @@ +;;;; Emacs Bookmark Format Version 1 ;;;; -*- coding: utf-8-emacs -*- +;;; This format is meant to be slightly human-readable; +;;; nevertheless, you probably don't want to edit it. +;;; -*- End Of Bookmark File Format Version Stamp -*- +(("name-0" + (filename . "/some/file-0") + (front-context-string . "abc") + (rear-context-string . "def") + (position . 3)) +("name-1" + (filename . "/some/file-1") + (front-context-string . "abc") + (rear-context-string . "def") + (position . 3)) +("name-2" + (filename . "/some/file-2") + (front-context-string . "abc") + (rear-context-string . "def") + (position . 3)) +) diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el index b9c6ff9c542..c5959e46d80 100644 --- a/test/lisp/bookmark-tests.el +++ b/test/lisp/bookmark-tests.el @@ -83,6 +83,70 @@ the lexically-bound variable `buffer'." ,@body) (kill-buffer buffer)))) +(defvar bookmark-tests-bookmark-file-list + (expand-file-name "test-list.bmk" bookmark-tests-data-dir) + "Bookmark file used for testing a list of bookmarks.") + +;; The values below should match `bookmark-tests-bookmark-file-list' +;; content. We cache these values to speed up tests. +(eval-and-compile ; needed by `with-bookmark-test-list' macro + (defvar bookmark-tests-bookmark-list-0 '("name-0" + (filename . "/some/file-0") + (front-context-string . "ghi") + (rear-context-string . "jkl") + (position . 4)) + "Cached value used in bookmark-tests.el.")) + +;; The values below should match `bookmark-tests-bookmark-file-list' +;; content. We cache these values to speed up tests. +(eval-and-compile ; needed by `with-bookmark-test-list' macro + (defvar bookmark-tests-bookmark-list-1 '("name-1" + (filename . "/some/file-1") + (front-context-string . "mno") + (rear-context-string . "pqr") + (position . 5)) + "Cached value used in bookmark-tests.el.")) + +;; The values below should match `bookmark-tests-bookmark-file-list' +;; content. We cache these values to speed up tests. +(eval-and-compile ; needed by `with-bookmark-test-list' macro + (defvar bookmark-tests-bookmark-list-2 '("name-2" + (filename . "/some/file-2") + (front-context-string . "stu") + (rear-context-string . "vwx") + (position . 6)) + "Cached value used in bookmark-tests.el.")) + +(defvar bookmark-tests-cache-timestamp-list + (cons bookmark-tests-bookmark-file-list + (nth 5 (file-attributes + bookmark-tests-bookmark-file-list))) + "Cached value used in bookmark-tests.el.") + +(defmacro with-bookmark-test-list (&rest body) + "Create environment for testing bookmark.el and evaluate BODY. +Ensure a clean environment for testing, and do not change user +data when running tests interactively." + `(with-temp-buffer + (let ((bookmark-alist (quote (,(copy-sequence bookmark-tests-bookmark-list-0) + ,(copy-sequence bookmark-tests-bookmark-list-1) + ,(copy-sequence bookmark-tests-bookmark-list-2)))) + (bookmark-default-file bookmark-tests-bookmark-file-list) + (bookmark-bookmarks-timestamp bookmark-tests-cache-timestamp-list) + bookmark-save-flag) + ,@body))) + +(defmacro with-bookmark-test-file-list (&rest body) + "Create environment for testing bookmark.el and evaluate BODY. +Same as `with-bookmark-test-list' but also opens the resource file +example.txt in a buffer, which can be accessed by callers through +the lexically-bound variable `buffer'." + `(let ((buffer (find-file-noselect bookmark-tests-example-file))) + (unwind-protect + (with-bookmark-test-list + ,@body) + (kill-buffer buffer)))) + (ert-deftest bookmark-tests-all-names () (with-bookmark-test (should (equal (bookmark-all-names) '("name"))))) @@ -95,6 +159,30 @@ the lexically-bound variable `buffer'." (with-bookmark-test (should (equal (bookmark-get-bookmark-record "name") (cdr bookmark-tests-bookmark))))) +(ert-deftest bookmark-tests-all-names-list () + (with-bookmark-test-list + (should (equal (bookmark-all-names) '("name-0" + "name-1" + "name-2"))))) + +(ert-deftest bookmark-tests-get-bookmark-list () + (with-bookmark-test-list + (should (equal (bookmark-get-bookmark "name-0") + bookmark-tests-bookmark-list-0)) + (should (equal (bookmark-get-bookmark "name-1") + bookmark-tests-bookmark-list-1)) + (should (equal (bookmark-get-bookmark "name-2") + bookmark-tests-bookmark-list-2)))) + +(ert-deftest bookmark-tests-get-bookmark-record-list () + (with-bookmark-test-list + (should (equal (bookmark-get-bookmark-record "name-0") + (cdr bookmark-tests-bookmark-list-0))) + (should (equal (bookmark-get-bookmark-record "name-1") + (cdr bookmark-tests-bookmark-list-1))) + (should (equal (bookmark-get-bookmark-record "name-2") + (cdr bookmark-tests-bookmark-list-2))))) + (ert-deftest bookmark-tests-record-getters-and-setters-new () (with-temp-buffer (let* ((buffer-file-name "test") @@ -130,6 +218,19 @@ the lexically-bound variable `buffer'." ;; calling twice gives same record (should (equal (bookmark-make-record) record)))))) +(ert-deftest bookmark-tests-make-record-list () + (with-bookmark-test-file-list + (let* ((record `("example.txt" (filename . ,bookmark-tests-example-file) + (front-context-string . "is text file is ") + (rear-context-string) + (position . 3) + (defaults "example.txt")))) + (with-current-buffer buffer + (goto-char 3) + (should (equal (bookmark-make-record) record)) + ;; calling twice gives same record + (should (equal (bookmark-make-record) record)))))) + (ert-deftest bookmark-tests-make-record-function () (with-bookmark-test (let ((buffer-file-name "test")) @@ -267,6 +368,11 @@ the lexically-bound variable `buffer'." (bookmark-delete "name") (should (equal bookmark-alist nil)))) +(ert-deftest bookmark-tests-delete-all () + (with-bookmark-test-list + (bookmark-delete-all t) + (should (equal bookmark-alist nil)))) + (defmacro with-bookmark-test-save-load (&rest body) "Create environment for testing bookmark.el and evaluate BODY. Same as `with-bookmark-test' but also sets a temporary @@ -340,6 +446,18 @@ testing `bookmark-bmenu-list'." ,@body) (kill-buffer bookmark-bmenu-buffer))))) +(defmacro with-bookmark-bmenu-test-list (&rest body) + "Create environment for testing `bookmark-bmenu-list' and evaluate BODY. +Same as `with-bookmark-test-list' but with additions suitable for +testing `bookmark-bmenu-list'." + `(with-bookmark-test-list + (let ((bookmark-bmenu-buffer "*Bookmark List - Testing*")) + (unwind-protect + (save-window-excursion + (bookmark-bmenu-list) + ,@body) + (kill-buffer bookmark-bmenu-buffer))))) + (ert-deftest bookmark-test-bmenu-edit-annotation/show-annotation () (with-bookmark-bmenu-test (bookmark-set-annotation "name" "foo") @@ -402,6 +520,52 @@ testing `bookmark-bmenu-list'." (beginning-of-line) (should (bookmark-bmenu-any-marks)))) +(ert-deftest bookmark-test-bmenu-mark-all () + (with-bookmark-bmenu-test-list + (let ((here (point-max))) + ;; Expect to not move the point + (goto-char here) + (bookmark-bmenu-mark-all) + (should (equal here (point))) + ;; Verify that all bookmarks are marked + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (should (looking-at "^> ")) + (should (equal bookmark-tests-bookmark-list-0 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^> ")) + (should (equal bookmark-tests-bookmark-list-1 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^> ")) + (should (equal bookmark-tests-bookmark-list-2 + (bookmark-get-bookmark (bookmark-bmenu-bookmark))))))) + +(ert-deftest bookmark-test-bmenu-any-marks-list () + (with-bookmark-bmenu-test-list + ;; Mark just the second item + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (forward-line 1) + (bookmark-bmenu-mark) + ;; Verify that only the second item is marked + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-0 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^> ")) + (should (equal bookmark-tests-bookmark-list-1 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-2 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + ;; There should be at least one mark + (should (bookmark-bmenu-any-marks)))) + (ert-deftest bookmark-test-bmenu-unmark () (with-bookmark-bmenu-test (bookmark-bmenu-mark) @@ -410,12 +574,63 @@ testing `bookmark-bmenu-list'." (beginning-of-line) (should (looking-at "^ ")))) +(ert-deftest bookmark-test-bmenu-unmark-all () + (with-bookmark-bmenu-test-list + (bookmark-bmenu-mark-all) + (let ((here (point-max))) + ;; Expect to not move the point + (goto-char here) + (bookmark-bmenu-unmark-all) + (should (equal here (point))) + ;; Verify that all bookmarks are unmarked + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-0 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-1 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^ ")) + (should (equal bookmark-tests-bookmark-list-2 + (bookmark-get-bookmark (bookmark-bmenu-bookmark))))))) + (ert-deftest bookmark-test-bmenu-delete () (with-bookmark-bmenu-test (bookmark-bmenu-delete) (bookmark-bmenu-execute-deletions) (should (equal (length bookmark-alist) 0)))) +(ert-deftest bookmark-test-bmenu-delete-all () + (with-bookmark-bmenu-test-list + ;; Verify that unmarked bookmarks aren't deleted + (bookmark-bmenu-execute-deletions) + (should-not (eq bookmark-alist nil)) + (let ((here (point-max))) + ;; Expect to not move the point + (goto-char here) + (bookmark-bmenu-delete-all) + (should (equal here (point))) + ;; Verify that all bookmarks are marked for deletion + (goto-char (point-min)) + (bookmark-bmenu-ensure-position) + (should (looking-at "^D ")) + (should (equal bookmark-tests-bookmark-list-0 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^D ")) + (should (equal bookmark-tests-bookmark-list-1 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + (forward-line 1) + (should (looking-at "^D ")) + (should (equal bookmark-tests-bookmark-list-2 + (bookmark-get-bookmark (bookmark-bmenu-bookmark)))) + ;; Verify that all bookmarks are deleted + (bookmark-bmenu-execute-deletions) + (should (eq bookmark-alist nil))))) + (ert-deftest bookmark-test-bmenu-locate () (let (msg) (cl-letf (((symbol-function 'message) diff --git a/test/lisp/cedet/srecode-utest-template.el b/test/lisp/cedet/srecode-utest-template.el index 63c33a3c440..7c5bbc599a3 100644 --- a/test/lisp/cedet/srecode-utest-template.el +++ b/test/lisp/cedet/srecode-utest-template.el @@ -323,7 +323,6 @@ INSIDE SECTION: ARG HANDLER ONE") (ert-deftest srecode-utest-project () "Test that project filtering works." - :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed) ; fixme (save-excursion (let ((testbuff (find-file-noselect srecode-utest-testfile)) (temp nil)) @@ -347,6 +346,10 @@ INSIDE SECTION: ARG HANDLER ONE") ;; Load the application templates, and make sure we can find them. (srecode-load-tables-for-mode major-mode 'tests) + (dolist (table (oref (srecode-table) tables)) + (when (gethash "test" (oref table contexthash)) + (oset table project default-directory))) + (setq temp (srecode-template-get-table (srecode-table) "test-project" "test" diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index c235dd43fcc..834e3b6d914 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -47,6 +47,11 @@ (let ((a 1.0)) (/ 3 a 2)) (let ((a most-positive-fixnum) (b 2.0)) (* a 2 b)) (let ((a 3) (b 2)) (/ a b 1.0)) + (let ((a -0.0)) (+ a)) + (let ((a -0.0)) (- a)) + (let ((a -0.0)) (* a)) + (let ((a -0.0)) (min a)) + (let ((a -0.0)) (max a)) (/ 3 -1) (+ 4 3 2 1) (+ 4 3 2.0 1) @@ -360,24 +365,24 @@ bytecompiled code, and their results compared.") (defun bytecomp-check-1 (pat) "Return non-nil if PAT is the same whether directly evalled or compiled." (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (v0 (condition-case nil + (byte-compile-warnings nil) + (v0 (condition-case err (eval pat) - (error 'bytecomp-check-error))) - (v1 (condition-case nil + (error (list 'bytecomp-check-error (car err))))) + (v1 (condition-case err (funcall (byte-compile (list 'lambda nil pat))) - (error 'bytecomp-check-error)))) + (error (list 'bytecomp-check-error (car err)))))) (equal v0 v1))) (put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) (defun bytecomp-explain-1 (pat) - (let ((v0 (condition-case nil + (let ((v0 (condition-case err (eval pat) - (error 'bytecomp-check-error))) - (v1 (condition-case nil + (error (list 'bytecomp-check-error (car err))))) + (v1 (condition-case err (funcall (byte-compile (list 'lambda nil pat))) - (error 'bytecomp-check-error)))) + (error (list 'bytecomp-check-error (car err)))))) (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." pat v0 v1))) @@ -400,12 +405,12 @@ Subtests signal errors if something goes wrong." (print-quoted t) v0 v1) (dolist (pat byte-opt-testsuite-arith-data) - (condition-case nil + (condition-case err (setq v0 (eval pat)) - (error (setq v0 'bytecomp-check-error))) - (condition-case nil + (error (setq v0 (list 'bytecomp-check-error (car err))))) + (condition-case err (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) - (error (setq v1 'bytecomp-check-error))) + (error (setq v1 (list 'bytecomp-check-error (car err))))) (insert (format "%s" pat)) (indent-to-column 65) (if (equal v0 v1) @@ -474,6 +479,7 @@ Subtests signal errors if something goes wrong." (ert-deftest bytecomp-tests--warnings () (with-current-buffer (get-buffer-create "*Compile-Log*") (let ((inhibit-read-only t)) (erase-buffer))) + (mapc #'fmakunbound '(my-test0 my--test11 my--test12 my--test2)) (test-byte-comp-compile-and-load t '(progn (defun my-test0 () @@ -559,25 +565,25 @@ bytecompiled code, and their results compared.") "Return non-nil if PAT is the same whether directly evalled or compiled." (let ((warning-minimum-log-level :emergency) (byte-compile-warnings nil) - (v0 (condition-case nil + (v0 (condition-case err (eval pat t) - (error 'bytecomp-check-error))) - (v1 (condition-case nil + (error (list 'bytecomp-check-error (car err))))) + (v1 (condition-case err (funcall (let ((lexical-binding t)) (byte-compile `(lambda nil ,pat)))) - (error 'bytecomp-check-error)))) + (error (list 'bytecomp-check-error (car err)))))) (equal v0 v1))) (put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1) (defun bytecomp-lexbind-explain-1 (pat) - (let ((v0 (condition-case nil + (let ((v0 (condition-case err (eval pat t) - (error 'bytecomp-check-error))) - (v1 (condition-case nil + (error (list 'bytecomp-check-error (car err))))) + (v1 (condition-case err (funcall (let ((lexical-binding t)) (byte-compile (list 'lambda nil pat)))) - (error 'bytecomp-check-error)))) + (error (list 'bytecomp-check-error (car err)))))) (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." pat v0 v1))) diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 57b9d23efb0..40dd7e4eeb0 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -242,6 +242,22 @@ (should (= (cl-the integer (cl-incf side-effect)) 1)) (should (= side-effect 1)))) +(ert-deftest cl-lib-test-incf () + (let ((var 0)) + (should (= (cl-incf var) 1)) + (should (= var 1))) + (let ((alist)) + (should (= (cl-incf (alist-get 'a alist 0)) 1)) + (should (= (alist-get 'a alist 0) 1)))) + +(ert-deftest cl-lib-test-decf () + (let ((var 1)) + (should (= (cl-decf var) 0)) + (should (= var 0))) + (let ((alist)) + (should (= (cl-decf (alist-get 'a alist 0)) -1)) + (should (= (alist-get 'a alist 0) -1)))) + (ert-deftest cl-lib-test-plusp () (should-not (cl-plusp -1.0e+INF)) (should-not (cl-plusp -1.5e2)) diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el new file mode 100644 index 00000000000..23cfc79d848 --- /dev/null +++ b/test/lisp/emacs-lisp/hierarchy-tests.el @@ -0,0 +1,556 @@ +;;; hierarchy-tests.el --- Tests for hierarchy.el + +;; Copyright (C) 2017-2019 Damien Cassou + +;; Author: Damien Cassou <damien@cassou.me> +;; Maintainer: emacs-devel@gnu.org + +;; 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: + +;; Tests for hierarchy.el + +;;; Code: + +(require 'ert) +(require 'hierarchy) + +(defun hierarchy-animals () + "Create a sorted animal hierarchy." + (let ((parentfn (lambda (item) (cl-case item + (dove 'bird) + (pigeon 'bird) + (bird 'animal) + (dolphin 'animal) + (cow 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'pigeon parentfn) + (hierarchy-add-tree hierarchy 'dolphin parentfn) + (hierarchy-add-tree hierarchy 'cow parentfn) + (hierarchy-sort hierarchy) + hierarchy)) + +(ert-deftest hierarchy-add-one-root () + (let ((parentfn (lambda (_) nil)) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'animal parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))))) + +(ert-deftest hierarchy-add-one-item-with-parent () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) + +(ert-deftest hierarchy-add-one-item-with-parent-and-grand-parent () + (let ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove))))) + +(ert-deftest hierarchy-add-same-root-twice () + (let ((parentfn (lambda (_) nil)) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'animal parentfn) + (hierarchy-add-tree hierarchy 'animal parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))))) + +(ert-deftest hierarchy-add-same-child-twice () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn) + (hierarchy-add-tree hierarchy 'bird parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) + +(ert-deftest hierarchy-add-item-and-its-parent () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn) + (hierarchy-add-tree hierarchy 'animal parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) + +(ert-deftest hierarchy-add-item-and-its-child () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'animal parentfn) + (hierarchy-add-tree hierarchy 'bird parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) + +(ert-deftest hierarchy-add-two-items-sharing-parent () + (let ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (pigeon 'bird)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'pigeon parentfn) + (should (equal (hierarchy-roots hierarchy) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-add-two-hierarchies () + (let ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (circle 'shape)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'circle parentfn) + (should (equal (hierarchy-roots hierarchy) '(bird shape))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove))) + (should (equal (hierarchy-children hierarchy 'shape) '(circle))))) + +(ert-deftest hierarchy-add-with-childrenfn () + (let ((childrenfn (lambda (item) + (cl-case item + (animal '(bird)) + (bird '(dove pigeon))))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'animal nil childrenfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-add-with-parentfn-and-childrenfn () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal) + (animal 'life-form)))) + (childrenfn (lambda (item) + (cl-case item + (bird '(dove pigeon)) + (pigeon '(ashy-wood-pigeon))))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn childrenfn) + (should (equal (hierarchy-roots hierarchy) '(life-form))) + (should (equal (hierarchy-children hierarchy 'life-form) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))) + (should (equal (hierarchy-children hierarchy 'pigeon) '(ashy-wood-pigeon))))) + +(ert-deftest hierarchy-add-twice-with-parentfn-and-childrenfn () + (let* ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (bird 'animal)))) + (childrenfn (lambda (item) + (cl-case item + (animal '(bird)) + (bird '(dove))))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn childrenfn) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove))))) + +(ert-deftest hierarchy-add-trees () + (let ((parentfn (lambda (item) + (cl-case item + (dove 'bird) + (pigeon 'bird) + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-trees hierarchy '(dove pigeon) parentfn) + (should (equal (hierarchy-roots hierarchy) '(animal))) + (should (equal (hierarchy-children hierarchy 'animal) '(bird))) + (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-from-list () + (let ((hierarchy (hierarchy-from-list + '(animal (bird (dove) + (pigeon)) + (cow) + (dolphin))))) + (hierarchy-sort hierarchy (lambda (item1 item2) + (string< (car item1) + (car item2)))) + (should (equal (hierarchy-to-string hierarchy (lambda (item) (symbol-name (car item)))) + "animal\n bird\n dove\n pigeon\n cow\n dolphin\n")))) + +(ert-deftest hierarchy-from-list-with-duplicates () + (let ((hierarchy (hierarchy-from-list + '(a (b) (b)) + t))) + (hierarchy-sort hierarchy (lambda (item1 item2) + ;; sort by ID + (< (car item1) (car item2)))) + (should (equal (hierarchy-length hierarchy) 3)) + (should (equal (hierarchy-to-string + hierarchy + (lambda (item) + (format "%s(%s)" + (cadr item) + (car item)))) + "a(1)\n b(2)\n b(3)\n")))) + +(ert-deftest hierarchy-from-list-with-childrenfn () + (let ((hierarchy (hierarchy-from-list + "abc" + nil + (lambda (item) + (when (string= item "abc") + (split-string item "" t)))))) + (hierarchy-sort hierarchy (lambda (item1 item2) (string< item1 item2))) + (should (equal (hierarchy-length hierarchy) 4)) + (should (equal (hierarchy-to-string hierarchy) + "abc\n a\n b\n c\n")))) + +(ert-deftest hierarchy-add-relation-check-error-when-different-parent () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'bird parentfn) + (should-error + (hierarchy--add-relation hierarchy 'bird 'cow #'identity)))) + +(ert-deftest hierarchy-empty-p-return-non-nil-for-empty () + (should (hierarchy-empty-p (hierarchy-new)))) + +(ert-deftest hierarchy-empty-p-return-nil-for-non-empty () + (should-not (hierarchy-empty-p (hierarchy-animals)))) + +(ert-deftest hierarchy-length-of-empty-is-0 () + (should (equal (hierarchy-length (hierarchy-new)) 0))) + +(ert-deftest hierarchy-length-of-non-empty-counts-items () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal) + (dove 'bird) + (pigeon 'bird)))) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'pigeon parentfn) + (should (equal (hierarchy-length hierarchy) 4)))) + +(ert-deftest hierarchy-has-root () + (let ((parentfn (lambda (item) + (cl-case item + (bird 'animal) + (dove 'bird) + (pigeon 'bird)))) + (hierarchy (hierarchy-new))) + (should-not (hierarchy-has-root hierarchy 'animal)) + (should-not (hierarchy-has-root hierarchy 'bird)) + (hierarchy-add-tree hierarchy 'dove parentfn) + (hierarchy-add-tree hierarchy 'pigeon parentfn) + (should (hierarchy-has-root hierarchy 'animal)) + (should-not (hierarchy-has-root hierarchy 'bird)))) + +(ert-deftest hierarchy-leafs () + (let ((animals (hierarchy-animals))) + (should (equal (hierarchy-leafs animals) + '(dove pigeon dolphin cow))))) + +(ert-deftest hierarchy-leafs-includes-lonely-roots () + (let ((parentfn (lambda (item) nil)) + (hierarchy (hierarchy-new))) + (hierarchy-add-tree hierarchy 'foo parentfn) + (should (equal (hierarchy-leafs hierarchy) + '(foo))))) + +(ert-deftest hierarchy-leafs-of-node () + (let ((animals (hierarchy-animals))) + (should (equal (hierarchy-leafs animals 'cow) '())) + (should (equal (hierarchy-leafs animals 'animal) '(dove pigeon dolphin cow))) + (should (equal (hierarchy-leafs animals 'bird) '(dove pigeon))) + (should (equal (hierarchy-leafs animals 'dove) '())))) + +(ert-deftest hierarchy-child-p () + (let ((animals (hierarchy-animals))) + (should (hierarchy-child-p animals 'dove 'bird)) + (should (hierarchy-child-p animals 'bird 'animal)) + (should (hierarchy-child-p animals 'cow 'animal)) + (should-not (hierarchy-child-p animals 'cow 'bird)) + (should-not (hierarchy-child-p animals 'bird 'cow)) + (should-not (hierarchy-child-p animals 'animal 'dove)) + (should-not (hierarchy-child-p animals 'animal 'bird)))) + +(ert-deftest hierarchy-descendant () + (let ((animals (hierarchy-animals))) + (should (hierarchy-descendant-p animals 'dove 'animal)) + (should (hierarchy-descendant-p animals 'dove 'bird)) + (should (hierarchy-descendant-p animals 'bird 'animal)) + (should (hierarchy-descendant-p animals 'cow 'animal)) + (should-not (hierarchy-descendant-p animals 'cow 'bird)) + (should-not (hierarchy-descendant-p animals 'bird 'cow)) + (should-not (hierarchy-descendant-p animals 'animal 'dove)) + (should-not (hierarchy-descendant-p animals 'animal 'bird)))) + +(ert-deftest hierarchy-descendant-if-not-same () + (let ((animals (hierarchy-animals))) + (should-not (hierarchy-descendant-p animals 'cow 'cow)) + (should-not (hierarchy-descendant-p animals 'dove 'dove)) + (should-not (hierarchy-descendant-p animals 'bird 'bird)) + (should-not (hierarchy-descendant-p animals 'animal 'animal)))) + +;; keywords supported: :test :key +(ert-deftest hierarchy--set-equal () + (should (hierarchy--set-equal '(1 2 3) '(1 2 3))) + (should (hierarchy--set-equal '(1 2 3) '(3 2 1))) + (should (hierarchy--set-equal '(3 2 1) '(1 2 3))) + (should-not (hierarchy--set-equal '(2 3) '(3 2 1))) + (should-not (hierarchy--set-equal '(1 2 3) '(2 3))) + (should-not (hierarchy--set-equal '("1" "2") '("2" "1") :test #'eq)) + (should (hierarchy--set-equal '("1" "2") '("2" "1") :test #'equal)) + (should-not (hierarchy--set-equal '(1 2) '(-1 -2))) + (should (hierarchy--set-equal '(1 2) '(-1 -2) :key #'abs)) + (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)))) + (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car)) + (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :test #'equal)) + (should (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car :test #'equal))) + +(ert-deftest hierarchy-equal-returns-true-for-same-hierarchy () + (let ((animals (hierarchy-animals))) + (should (hierarchy-equal animals animals)) + (should (hierarchy-equal (hierarchy-animals) animals)))) + +(ert-deftest hierarchy-equal-returns-true-for-hierarchy-copies () + (let ((animals (hierarchy-animals))) + (should (hierarchy-equal animals (hierarchy-copy animals))))) + +(ert-deftest hierarchy-map-item-on-leaf () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-item (lambda (item indent) (cons item indent)) + 'cow + animals))) + (should (equal result '((cow . 0)))))) + +(ert-deftest hierarchy-map-item-on-leaf-with-indent () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-item (lambda (item indent) (cons item indent)) + 'cow + animals + 2))) + (should (equal result '((cow . 2)))))) + +(ert-deftest hierarchy-map-item-on-parent () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-item (lambda (item indent) (cons item indent)) + 'bird + animals))) + (should (equal result '((bird . 0) (dove . 1) (pigeon . 1)))))) + +(ert-deftest hierarchy-map-item-on-grand-parent () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-item (lambda (item indent) (cons item indent)) + 'animal + animals))) + (should (equal result '((animal . 0) (bird . 1) (dove . 2) (pigeon . 2) + (cow . 1) (dolphin . 1)))))) + +(ert-deftest hierarchy-map-conses () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map (lambda (item indent) + (cons item indent)) + animals))) + (should (equal result '((animal . 0) + (bird . 1) + (dove . 2) + (pigeon . 2) + (cow . 1) + (dolphin . 1)))))) + +(ert-deftest hierarchy-map-tree () + (let ((animals (hierarchy-animals))) + (should (equal (hierarchy-map-tree (lambda (item indent children) + (list item indent children)) + animals) + '(animal + 0 + ((bird 1 ((dove 2 nil) (pigeon 2 nil))) + (cow 1 nil) + (dolphin 1 nil))))))) + +(ert-deftest hierarchy-map-hierarchy-keeps-hierarchy () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-map-hierarchy (lambda (item _) (identity item)) + animals))) + (should (hierarchy-equal animals result)))) + +(ert-deftest hierarchy-map-applies-function () + (let* ((animals (hierarchy-animals)) + (parentfn (lambda (item) + (cond + ((equal item "bird") "animal") + ((equal item "dove") "bird") + ((equal item "pigeon") "bird") + ((equal item "cow") "animal") + ((equal item "dolphin") "animal")))) + (expected (hierarchy-new))) + (hierarchy-add-tree expected "dove" parentfn) + (hierarchy-add-tree expected "pigeon" parentfn) + (hierarchy-add-tree expected "cow" parentfn) + (hierarchy-add-tree expected "dolphin" parentfn) + (should (hierarchy-equal + (hierarchy-map-hierarchy (lambda (item _) (symbol-name item)) animals) + expected)))) + +(ert-deftest hierarchy-extract-tree () + (let* ((animals (hierarchy-animals)) + (birds (hierarchy-extract-tree animals 'bird))) + (hierarchy-sort birds) + (should (equal (hierarchy-roots birds) '(animal))) + (should (equal (hierarchy-children birds 'animal) '(bird))) + (should (equal (hierarchy-children birds 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-extract-tree-nil-if-not-in-hierarchy () + (let* ((animals (hierarchy-animals))) + (should-not (hierarchy-extract-tree animals 'foobar)))) + +(ert-deftest hierarchy-items-of-empty-hierarchy-is-empty () + (should (seq-empty-p (hierarchy-items (hierarchy-new))))) + +(ert-deftest hierarchy-items-returns-sequence-of-same-length () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-items animals))) + (should (= (seq-length result) (hierarchy-length animals))))) + +(ert-deftest hierarchy-items-return-all-elements-of-hierarchy () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-items animals))) + (should (equal (seq-sort #'string< result) '(animal bird cow dolphin dove pigeon))))) + +(ert-deftest hierarchy-labelfn-indent-no-indent-if-0 () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (labelfn (hierarchy-labelfn-indent labelfn-base))) + (should (equal + (with-temp-buffer + (funcall labelfn "bar" 0) + (buffer-substring (point-min) (point-max))) + "foo")))) + +(ert-deftest hierarchy-labelfn-indent-three-times-if-3 () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (labelfn (hierarchy-labelfn-indent labelfn-base))) + (should (equal + (with-temp-buffer + (funcall labelfn "bar" 3) + (buffer-substring (point-min) (point-max))) + " foo")))) + +(ert-deftest hierarchy-labelfn-indent-default-indent-string () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (labelfn (hierarchy-labelfn-indent labelfn-base))) + (should (equal + (with-temp-buffer + (funcall labelfn "bar" 1) + (buffer-substring (point-min) (point-max))) + " foo")))) + +(ert-deftest hierarchy-labelfn-indent-custom-indent-string () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (labelfn (hierarchy-labelfn-indent labelfn-base "###")) + (content (with-temp-buffer + (funcall labelfn "bar" 1) + (buffer-substring (point-min) (point-max))))) + (should (equal content "###foo")))) + +(ert-deftest hierarchy-labelfn-button-propertize () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (actionfn #'identity) + (labelfn (hierarchy-labelfn-button labelfn-base actionfn)) + (properties (with-temp-buffer + (funcall labelfn "bar" 1) + (text-properties-at 1)))) + (should (equal (car properties) 'action)))) + +(ert-deftest hierarchy-labelfn-button-execute-labelfn () + (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (actionfn #'identity) + (labelfn (hierarchy-labelfn-button labelfn-base actionfn)) + (content (with-temp-buffer + (funcall labelfn "bar" 1) + (buffer-substring-no-properties (point-min) (point-max))))) + (should (equal content "foo")))) + +(ert-deftest hierarchy-labelfn-button-if-does-not-button-unless-condition () + (let ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (spy-count 0) + (condition (lambda (_item _indent) nil))) + (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count))))) + (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil) + (should (equal spy-count 0))))) + +(ert-deftest hierarchy-labelfn-button-if-does-button-when-condition () + (let ((labelfn-base (lambda (_item _indent) (insert "foo"))) + (spy-count 0) + (condition (lambda (_item _indent) t))) + (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count))))) + (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil) + (should (equal spy-count 1))))) + +(ert-deftest hierarchy-labelfn-to-string () + (let ((labelfn (lambda (item _indent) (insert item)))) + (should (equal (hierarchy-labelfn-to-string labelfn "foo" 1) "foo")))) + +(ert-deftest hierarchy-print () + (let* ((animals (hierarchy-animals)) + (result (with-temp-buffer + (hierarchy-print animals) + (buffer-substring-no-properties (point-min) (point-max))))) + (should (equal result "animal\n bird\n dove\n pigeon\n cow\n dolphin\n")))) + +(ert-deftest hierarchy-to-string () + (let* ((animals (hierarchy-animals)) + (result (hierarchy-to-string animals))) + (should (equal result "animal\n bird\n dove\n pigeon\n cow\n dolphin\n")))) + +(ert-deftest hierarchy-tabulated-display () + (let* ((animals (hierarchy-animals)) + (labelfn (lambda (item _indent) (insert (symbol-name item)))) + (contents (with-temp-buffer + (hierarchy-tabulated-display animals labelfn (current-buffer)) + (buffer-substring-no-properties (point-min) (point-max))))) + (should (equal contents "animal\nbird\ndove\npigeon\ncow\ndolphin\n")))) + +(ert-deftest hierarchy-sort-non-root-nodes () + (let* ((animals (hierarchy-animals))) + (should (equal (hierarchy-roots animals) '(animal))) + (should (equal (hierarchy-children animals 'animal) '(bird cow dolphin))) + (should (equal (hierarchy-children animals 'bird) '(dove pigeon))))) + +(ert-deftest hierarchy-sort-roots () + (let* ((organisms (hierarchy-new)) + (parentfn (lambda (item) + (cl-case item + (oak 'plant) + (bird 'animal))))) + (hierarchy-add-tree organisms 'oak parentfn) + (hierarchy-add-tree organisms 'bird parentfn) + (hierarchy-sort organisms) + (should (equal (hierarchy-roots organisms) '(animal plant))))) + +(provide 'hierarchy-tests) +;;; hierarchy-tests.el ends here diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index 8736ac70201..a2b8304c96a 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -367,6 +367,61 @@ start." " "Test buffer for `mark-defun'.")) +;;; end-of-defun + +(ert-deftest end-of-defun-twice () + "Test behavior of prefix arg for `end-of-defun' (Bug#24427). +Calling `end-of-defun' twice should be the same as a prefix arg +of two." + (setq last-command nil) + (cl-flet ((eod2 (lambda () + (goto-char (point-min)) + (end-of-defun) + (end-of-defun) + (let ((pt-eod2 (point))) + (goto-char (point-min)) + (end-of-defun 2) + (should (= (point) pt-eod2)))))) + (with-temp-buffer + (insert "\ +\(defun a ()) + +\(defun b ()) + +\(defun c ())") + (eod2)) + (with-temp-buffer + (insert "\ +\(defun a ()) +\(defun b ()) +\(defun c ())") + (eod2))) + (elisp-tests-with-temp-buffer ";; Comment header + +\(defun func-1 (arg) + \"docstring\" + body) +=!p1= +;; Comment before a defun +\(defun func-2 (arg) + \"docstring\" + body) + +\(defun func-3 (arg) + \"docstring\" + body) +=!p2=(defun func-4 (arg) + \"docstring\" + body) + +;; end +" + (goto-char p1) + (end-of-defun 2) + (should (= (point) p2)))) + +;;; mark-defun + (ert-deftest mark-defun-no-arg-region-inactive () "Test `mark-defun' with no prefix argument and inactive region." diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index 30c8f794577..e8c12669c1a 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -77,6 +77,46 @@ left alone when opening a URL in an external browser." (should (compare-window-configurations (current-window-configuration) old)) (should (equal urls '("https://www.gnu.org"))))) +(defun ffap-test-string (space string) + (let ((ffap-file-name-with-spaces space)) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (forward-char 10) + (ffap-string-at-point)))) + +(ert-deftest ffap-test-with-spaces () + (should + (equal + (ffap-test-string + t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt") + "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt")) + (should + (equal + (ffap-test-string + nil "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt") + "c:/Program")) + (should + (equal + (ffap-test-string + t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program Files/Hummingbird/") + "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program Files/Hummingbird/")) + (should + (equal + (ffap-test-string + t "c:\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14 x86\\Program Files\\Hummingbird\\") + "\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14 x86\\Program Files\\Hummingbird\\")) + (should + (equal + (ffap-test-string + t "c:\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx 2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt") + "\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx 2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt")) + (should + (equal + (ffap-test-string + t "C:\\temp\\program.log on Windows or /var/log/program.log on Unix.") + "\\temp\\program.log"))) + (provide 'ffap-tests) ;;; ffap-tests.el ends here diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 4b902fd82ae..5b2f5fd6f0f 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -190,7 +190,6 @@ form.") (ert-deftest files-tests-bug-21454 () "Test for https://debbugs.gnu.org/21454 ." - :expected-result :failed (let ((input-result '(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/")) ("/foo/bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) @@ -1362,5 +1361,9 @@ See <https://debbugs.gnu.org/36401>." (normal-mode) (should (not (eq major-mode 'text-mode)))))) +(ert-deftest files-colon-path () + (should (equal (parse-colon-path "/foo//bar/baz") + '("/foo/bar/baz/")))) + (provide 'files-tests) ;;; files-tests.el ends here diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el index 917e627c7ec..07da4bffa5a 100644 --- a/test/lisp/gnus/mml-sec-tests.el +++ b/test/lisp/gnus/mml-sec-tests.el @@ -623,6 +623,7 @@ In this test, encrypt-to-self variables are set to lists." (ert-deftest mml-secure-en-decrypt-sign-1-1-single () "Sign and encrypt message; then decrypt and test for expected result. In this test, just multiple encryption and signing keys may be available." + :tags '(:unstable) (skip-unless (test-conf)) (mml-secure-test-key-fixture (lambda () @@ -662,6 +663,7 @@ In this test, just multiple encryption and signing keys may be available." (ert-deftest mml-secure-en-decrypt-sign-1-3-double () "Sign and encrypt message; then decrypt and test for expected result. In this test, just multiple encryption and signing keys may be available." + :tags '(:unstable) (skip-unless (test-conf)) (mml-secure-test-key-fixture (lambda () @@ -679,6 +681,7 @@ In this test, just multiple encryption and signing keys may be available." (ert-deftest mml-secure-en-decrypt-sign-2 () "Sign and encrypt message; then decrypt and test for expected result. In this test, lists of encryption and signing keys are customized." + :tags '(:unstable) (skip-unless (test-conf)) (mml-secure-test-key-fixture (lambda () @@ -713,6 +716,7 @@ In this test, lists of encryption and signing keys are customized." (ert-deftest mml-secure-en-decrypt-sign-3 () "Sign and encrypt message; then decrypt and test for expected result. Use sign-with-sender and encrypt-to-self." + :tags '(:unstable) (skip-unless (test-conf)) (mml-secure-test-key-fixture (lambda () diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index d2dc3d24aec..da2b49e6b84 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -160,4 +160,15 @@ Return first line of the output of (describe-function-1 FUNC)." (with-current-buffer "*Help*" (should (looking-at "^help-fns-test--describe-keymap-foo is")))) +;;; Tests for find-lisp-object-file-name +(ert-deftest help-fns-test-bug24697-function-search () + (should-not (find-lisp-object-file-name 'tab-width 1))) + +(ert-deftest help-fns-test-bug24697-non-internal-variable () + (let ((help-fns--test-var (make-symbol "help-fns--test-var"))) + ;; simulate an internal variable + (put help-fns--test-var 'variable-documentation 1) + (should-not (find-lisp-object-file-name help-fns--test-var 'defface)) + (should-not (find-lisp-object-file-name help-fns--test-var 1)))) + ;;; help-fns-tests.el ends here diff --git a/test/lisp/mail/flow-fill-tests.el b/test/lisp/mail/flow-fill-tests.el index 4d435aeda71..c2e4178b7d4 100644 --- a/test/lisp/mail/flow-fill-tests.el +++ b/test/lisp/mail/flow-fill-tests.el @@ -35,7 +35,8 @@ ">>> unmuzzled ratsbane!\n" ">>>> Henceforth, the coding style is to be strictly \n" ">>>> enforced, including the use of only upper case.\n" - ">>>>> I've noticed a lack of adherence to the coding \n" + ">>>>> I've noticed a lack of adherence to \n" + ">>>>> the coding \n" ">>>>> styles, of late.\n" ">>>>>> Any complaints?\n")) (output diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el new file mode 100644 index 00000000000..b2b27d2ae7b --- /dev/null +++ b/test/lisp/net/browse-url-tests.el @@ -0,0 +1,119 @@ +;;; browse-url-tests.el --- Tests for browse-url.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl <simenheg@gmail.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 'browse-url) +(require 'ert) + +(ert-deftest browse-url-tests-browser-kind () + (should (eq (browse-url--browser-kind #'browse-url-w3 "gnu.org") + 'internal)) + (should + (eq (browse-url--browser-kind #'browse-url-firefox "gnu.org") + 'external))) + +(ert-deftest browse-url-tests-non-html-file-url-p () + (should (browse-url--non-html-file-url-p "file://foo.txt")) + (should-not (browse-url--non-html-file-url-p "file://foo.html"))) + +(ert-deftest browse-url-tests-select-handler-mailto () + (should (eq (browse-url-select-handler "mailto:foo@bar.org") + 'browse-url--mailto)) + (should (eq (browse-url-select-handler "mailto:foo@bar.org" + 'internal) + 'browse-url--mailto)) + (should-not (browse-url-select-handler "mailto:foo@bar.org" + 'external))) + +(ert-deftest browse-url-tests-select-handler-man () + (should (eq (browse-url-select-handler "man:ls") 'browse-url--man)) + (should (eq (browse-url-select-handler "man:ls" 'internal) + 'browse-url--man)) + (should-not (browse-url-select-handler "man:ls" 'external))) + +(ert-deftest browse-url-tests-select-handler-file () + (should (eq (browse-url-select-handler "file://foo.txt") + 'browse-url-emacs)) + (should (eq (browse-url-select-handler "file://foo.txt" 'internal) + 'browse-url-emacs)) + (should-not (browse-url-select-handler "file://foo.txt" 'external))) + +(ert-deftest browse-url-tests-url-encode-chars () + (should (equal (browse-url-url-encode-chars "foobar" "[ob]") + "f%6F%6F%62ar"))) + +(ert-deftest browse-url-tests-encode-url () + (should (equal (browse-url-encode-url "") "")) + (should (equal (browse-url-encode-url "a b c") "a b c")) + (should (equal (browse-url-encode-url "\"a\" \"b\"") + "\"a%22\"b\"")) + (should (equal (browse-url-encode-url "(a) (b)") "(a%29(b)")) + (should (equal (browse-url-encode-url "a$ b$") "a%24b$"))) + +(ert-deftest browse-url-tests-url-at-point () + (with-temp-buffer + (insert "gnu.org") + (should (equal (browse-url-url-at-point) "http://gnu.org")))) + +(ert-deftest browse-url-tests-file-url () + (should (equal (browse-url-file-url "/foo") "file:///foo")) + (should (equal (browse-url-file-url "/foo:") "ftp://foo/")) + (should (equal (browse-url-file-url "/ftp@foo:") "ftp://foo/")) + (should (equal (browse-url-file-url "/anonymous@foo:") + "ftp://foo/"))) + +(ert-deftest browse-url-tests-delete-temp-file () + (let ((browse-url-temp-file-name + (make-temp-file "browse-url-tests-"))) + (browse-url-delete-temp-file) + (should-not (file-exists-p browse-url-temp-file-name))) + (let ((file (make-temp-file "browse-url-tests-"))) + (browse-url-delete-temp-file file) + (should-not (file-exists-p file)))) + +(ert-deftest browse-url-tests-add-buttons () + (with-temp-buffer + (insert "Visit https://gnu.org") + (goto-char (point-min)) + (browse-url-add-buttons) + (goto-char (- (point-max) 1)) + (should (eq (get-text-property (point) 'face) + 'browse-url-button)) + (should (get-text-property (point) 'browse-url-data)))) + +(ert-deftest browse-url-tests-button-copy () + (with-temp-buffer + (insert "Visit https://gnu.org") + (goto-char (point-min)) + (browse-url-add-buttons) + (should-error (browse-url-button-copy)) + (goto-char (- (point-max) 1)) + (browse-url-button-copy) + (should (equal (car kill-ring) "https://gnu.org")))) + +(provide 'browse-url-tests) +;;; browse-url-tests.el ends here diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index cd736497e66..d566e7dd862 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -435,8 +435,8 @@ The test data is in `compile-tests--test-regexps-data'." (compilation-num-infos-found 0)) (mapc #'compile--test-error-line compile-tests--test-regexps-data) (should (eq compilation-num-errors-found 94)) - (should (eq compilation-num-warnings-found 37)) - (should (eq compilation-num-infos-found 26))))) + (should (eq compilation-num-warnings-found 35)) + (should (eq compilation-num-infos-found 28))))) (ert-deftest compile-test-grep-regexps () "Test the `grep-regexp-alist' regexps. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el new file mode 100644 index 00000000000..be8b42d99a8 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -0,0 +1,51 @@ +;;; cperl-mode-tests --- Test for cperl-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Harald Jörg <haj@posteo.de> +;; Maintainer: Harald Jörg +;; Keywords: internal +;; Homepage: https://github.com/HaraldJoerg/cperl-mode + +;;; Commentary: + +;; This is a collection of tests for the fontification of CPerl-mode. + +;; Run these tests interactively: +;; (ert-run-tests-interactively '(tag :fontification)) + +;;; Code: + +(defvar cperl-test-mode #'cperl-mode) + +(defun cperl-test-ppss (text regexp) + "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT." + (interactive) + (with-temp-buffer + (insert text) + (funcall cperl-test-mode) + (goto-char (point-min)) + (re-search-forward regexp) + (syntax-ppss))) + +(ert-deftest cperl-mode-test-bug-42168 () + "Verify that '/' is a division after ++ or --, not a regexp. +Reported in https://github.com/jrockway/cperl-mode/issues/45. +If seen as regular expression, then the slash is displayed using +font-lock-constant-face. If seen as a division, then it doesn't +have a face property." + :tags '(:fontification) + ;; The next two Perl expressions have divisions. Perl "punctuation" + ;; operators don't get a face. + (let ((code "{ $a++ / $b }")) + (should (equal (nth 8 (cperl-test-ppss code "/")) nil))) + (let ((code "{ $a-- / $b }")) + (should (equal (nth 8 (cperl-test-ppss code "/")) nil))) + ;; The next two Perl expressions have regular expressions. The + ;; delimiter of a RE is fontified with font-lock-constant-face. + (let ((code "{ $a+ / $b } # /")) + (should (equal (nth 8 (cperl-test-ppss code "/")) 7))) + (let ((code "{ $a- / $b } # /")) + (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))) + +;;; cperl-mode-tests.el ends here diff --git a/test/lisp/saveplace-resources/saveplace b/test/lisp/saveplace-resources/saveplace new file mode 100644 index 00000000000..3f3f6d501d6 --- /dev/null +++ b/test/lisp/saveplace-resources/saveplace @@ -0,0 +1,4 @@ +;;; -*- coding: utf-8 -*- +(("/home/skangas/.emacs.d/cache/recentf" . 1306) + ("/home/skangas/wip/emacs/" + (dired-filename . "/home/skangas/wip/emacs/COPYING"))) diff --git a/test/lisp/saveplace-tests.el b/test/lisp/saveplace-tests.el new file mode 100644 index 00000000000..ae7749fe930 --- /dev/null +++ b/test/lisp/saveplace-tests.el @@ -0,0 +1,103 @@ +;;; saveplace-tests.el --- Tests for saveplace.el -*- lexical-binding:t -*- + +;; Copyright (C) 2019-2020 Free Software Foundation, Inc. + +;; Author: Stefan Kangas <stefankangas@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +(require 'ert) +(require 'saveplace) + +(defvar saveplace-tests-dir + (file-truename + (expand-file-name "saveplace-resources" + (file-name-directory (or load-file-name + buffer-file-name))))) + +(ert-deftest saveplace-test-save-place-to-alist/dir () + (save-place-mode) + (let* ((save-place-alist nil) + (save-place-loaded t) + (loc saveplace-tests-dir)) + (save-window-excursion + (dired loc) + (save-place-to-alist) + (should (equal save-place-alist + `((,(concat loc "/") + (dired-filename . ,(concat loc "/saveplace"))))))))) + +(ert-deftest saveplace-test-save-place-to-alist/file () + (save-place-mode) + (let* ((tmpfile (make-temp-file "emacs-test-saveplace-")) + (save-place-alist nil) + (save-place-loaded t) + (loc tmpfile) + (pos 4)) + (unwind-protect + (save-window-excursion + (find-file loc) + (insert "abc") ; must insert something + (save-place-to-alist) + (should (equal save-place-alist (list (cons tmpfile pos))))) + (delete-file tmpfile)))) + +(ert-deftest saveplace-test-forget-unreadable-files () + (save-place-mode) + (let* ((save-place-loaded t) + (tmpfile (make-temp-file "emacs-test-saveplace-")) + (alist-orig (list (cons "/this/file/does/not/exist" 10) + (cons tmpfile 1917))) + (save-place-alist alist-orig)) + (unwind-protect + (progn + (save-place-forget-unreadable-files) + (should (equal save-place-alist (cdr alist-orig)))) + (delete-file tmpfile)))) + +(ert-deftest saveplace-test-place-alist-to-file () + (save-place-mode) + (let* ((tmpfile (make-temp-file "emacs-test-saveplace-")) + (tmpfile2 (make-temp-file "emacs-test-saveplace-")) + (save-place-file tmpfile) + (save-place-alist (list (cons tmpfile2 99)))) + (unwind-protect + (progn (save-place-alist-to-file) + (setq save-place-alist nil) + (save-window-excursion + (find-file save-place-file) + (unwind-protect + (should (string-match tmpfile2 (buffer-string))) + (kill-buffer)))) + (delete-file tmpfile) + (delete-file tmpfile2)))) + +(ert-deftest saveplace-test-load-alist-from-file () + (save-place-mode) + (let ((save-place-loaded nil) + (save-place-file + (expand-file-name "saveplace" saveplace-tests-dir)) + (save-place-alist nil)) + (load-save-place-alist-from-file) + (should (equal save-place-alist + '(("/home/skangas/.emacs.d/cache/recentf" . 1306) + ("/home/skangas/wip/emacs/" + (dired-filename . "/home/skangas/wip/emacs/COPYING"))))))) + +(provide 'saveplace-tests) +;;; saveplace-tests.el ends here diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 4adcacb279b..63e504bbe17 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -39,6 +39,13 @@ (with-no-warnings (simple-test--buffer-substrings)))) +;;; `count-words' +(ert-deftest simple-test-count-words-bug-41761 () + (with-temp-buffer + (dotimes (i 10) (insert (propertize "test " 'field (cons nil nil)))) + (should (= (count-words (point-min) (point-max)) 10)))) + + ;;; `transpose-sexps' (defmacro simple-test--transpositions (&rest body) (declare (indent 0) diff --git a/test/lisp/textmodes/bibtex-tests.el b/test/lisp/textmodes/bibtex-tests.el new file mode 100644 index 00000000000..b3858de9e61 --- /dev/null +++ b/test/lisp/textmodes/bibtex-tests.el @@ -0,0 +1,57 @@ +;;; bibtex-tests.el --- Test suite for bibtex. + +;; Copyright (C) 2013-2020 Free Software Foundation, Inc. + +;; Keywords: bibtex + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'bibtex) + +(ert-deftest bibtex-test-set-dialect () + "Tests if `bibtex-set-dialect' is executed." + (with-temp-buffer + (insert "@article{someID, + author = {some author}, + title = {some title}, +}") + (bibtex-mode) + (should-not (null bibtex-dialect)) + (should-not (null bibtex-entry-type)) + (should-not (null bibtex-entry-head)) + (should-not (null bibtex-reference-key)) + (should-not (null bibtex-entry-head)) + (should-not (null bibtex-entry-maybe-empty-head)) + (should-not (null bibtex-any-valid-entry-type)))) + +(ert-deftest bibtex-test-parse-buffers-stealthily () + "Tests if `bibtex-parse-buffers-stealthily' can be executed." + (with-temp-buffer + (insert "@article{someID, + author = {some author}, + title = {some title}, +}") + (bibtex-mode) + (should (progn (bibtex-parse-buffers-stealthily) t)))) + +(provide 'bibtex-tests) + +;;; bibtex-tests.el ends here diff --git a/test/lisp/textmodes/paragraphs-tests.el b/test/lisp/textmodes/paragraphs-tests.el index fc839fe7d95..0b264e7e184 100644 --- a/test/lisp/textmodes/paragraphs-tests.el +++ b/test/lisp/textmodes/paragraphs-tests.el @@ -50,8 +50,8 @@ (goto-char (point-min)) (mark-paragraph) (should mark-active) - (should (equal (mark) 7))) - (should-error (mark-paragraph 0))) + (should (equal (mark) 7)))) +;;; (should-error (mark-paragraph 0))) (ert-deftest paragraphs-tests-kill-paragraph () (with-temp-buffer diff --git a/test/lisp/url/url-expand-tests.el b/test/lisp/url/url-expand-tests.el index 6e0ce869502..3b0b6fbd41a 100644 --- a/test/lisp/url/url-expand-tests.el +++ b/test/lisp/url/url-expand-tests.el @@ -100,6 +100,13 @@ (should (equal (url-expand-file-name "foo#bar" "http://host/foobar") "http://host/foo#bar")) (should (equal (url-expand-file-name "foo#bar" "http://host/foobar/") "http://host/foobar/foo#bar"))) +(ert-deftest url-expand-file-name/relative-resolution-file-url () + "RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.1. Normal Examples" + (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/foo.html") "file:///a/b/c/bar.html")) + (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/") "file:///a/b/c/bar.html")) + (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/") "file:///a/b/d/bar.html")) + (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/foo.html") "file:///a/b/d/bar.html"))) + (provide 'url-expand-tests) ;;; url-expand-tests.el ends here diff --git a/test/manual/etags/c-src/abbrev.c b/test/manual/etags/c-src/abbrev.c index 03b9f0e65b8..44563d6046a 100644 --- a/test/manual/etags/c-src/abbrev.c +++ b/test/manual/etags/c-src/abbrev.c @@ -78,9 +78,6 @@ Lisp_Object Vlast_abbrev_text; int last_abbrev_point; -/* Hook to run before expanding any abbrev. */ - -Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0, "Create a new, empty abbrev table object.") @@ -232,9 +229,6 @@ Returns the abbrev symbol, if expansion took place.") value = Qnil; - if (!NILP (Vrun_hooks)) - call1 (Vrun_hooks, Qpre_abbrev_expand_hook); - wordstart = 0; if (!(BUFFERP (Vabbrev_start_location_buffer) && XBUFFER (Vabbrev_start_location_buffer) == current_buffer)) @@ -595,14 +589,6 @@ This causes `save-some-buffers' to offer to save the abbrevs."); "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so."); abbrev_all_caps = 0; - DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook, - "Function or functions to be called before abbrev expansion is done.\n\ -This is the first thing that `expand-abbrev' does, and so this may change\n\ -the current abbrev table before abbrev lookup happens."); - Vpre_abbrev_expand_hook = Qnil; - Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook"); - staticpro (&Qpre_abbrev_expand_hook); - defsubr (&Smake_abbrev_table); defsubr (&Sclear_abbrev_table); defsubr (&Sdefine_abbrev); diff --git a/test/manual/image-circular-tests.el b/test/manual/image-circular-tests.el new file mode 100644 index 00000000000..33ea3ea9547 --- /dev/null +++ b/test/manual/image-circular-tests.el @@ -0,0 +1,144 @@ +;;; image-tests.el --- Test suite for image-related functions. + +;; Copyright (C) 2019 Free Software Foundation, Inc. + +;; Author: Pip Cet <pipcet@gmail.com> +;; Keywords: internal +;; Human-Keywords: internal + +;; 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) + +(ert-deftest image-test-duplicate-keywords () + "Test that duplicate keywords in an image spec lead to rejection." + (should-error (image-size `(image :type xbm :type xbm :width 1 :height 1 + :data ,(bool-vector t)) + t))) + +(ert-deftest image-test-circular-plist () + "Test that a circular image spec is rejected." + (should-error + (let ((l `(image :type xbm :width 1 :height 1 :data ,(bool-vector t)))) + (setcdr (last l) '#1=(:invalid . #1#)) + (image-size l t)))) + +(ert-deftest image-test-:type-property-value () + "Test that :type is allowed as a property value in an image spec." + (should (equal (image-size `(image :dummy :type :type xbm :width 1 :height 1 + :data ,(bool-vector t)) + t) + (cons 1 1)))) + +(ert-deftest image-test-circular-specs () + "Test that circular image spec property values do not cause infinite recursion." + (should + (let* ((circ1 (cons :dummy nil)) + (circ2 (cons :dummy nil)) + (spec1 `(image :type xbm :width 1 :height 1 + :data ,(bool-vector 1) :ignored ,circ1)) + (spec2 `(image :type xbm :width 1 :height 1 + :data ,(bool-vector 1) :ignored ,circ2))) + (setcdr circ1 circ1) + (setcdr circ2 circ2) + (and (equal (image-size spec1 t) (cons 1 1)) + (equal (image-size spec2 t) (cons 1 1)))))) + +(provide 'image-tests) +;;; image-tests.el ends here. +;;; image-tests.el --- tests for image.el -*- lexical-binding: t -*- + +;; Copyright (C) 2019-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 'image) +(eval-when-compile + (require 'cl-lib)) + +(defconst image-tests--emacs-images-directory + (expand-file-name "../etc/images" (getenv "EMACS_TEST_DIRECTORY")) + "Directory containing Emacs images.") + +(ert-deftest image--set-property () + "Test `image--set-property' behavior." + (let ((image (list 'image))) + ;; Add properties. + (setf (image-property image :scale) 1) + (should (equal image '(image :scale 1))) + (setf (image-property image :width) 8) + (should (equal image '(image :scale 1 :width 8))) + (setf (image-property image :height) 16) + (should (equal image '(image :scale 1 :width 8 :height 16))) + ;; Delete properties. + (setf (image-property image :type) nil) + (should (equal image '(image :scale 1 :width 8 :height 16))) + (setf (image-property image :scale) nil) + (should (equal image '(image :width 8 :height 16))) + (setf (image-property image :height) nil) + (should (equal image '(image :width 8))) + (setf (image-property image :width) nil) + (should (equal image '(image))))) + +(ert-deftest image-type-from-file-header-test () + "Test image-type-from-file-header." + (should (eq (if (image-type-available-p 'svg) 'svg) + (image-type-from-file-header + (expand-file-name "splash.svg" + image-tests--emacs-images-directory))))) + +(ert-deftest image-rotate () + "Test `image-rotate'." + (cl-letf* ((image (list 'image)) + ((symbol-function 'image--get-imagemagick-and-warn) + (lambda () image))) + (let ((current-prefix-arg '(4))) + (call-interactively #'image-rotate)) + (should (equal image '(image :rotation 270.0))) + (call-interactively #'image-rotate) + (should (equal image '(image :rotation 0.0))) + (image-rotate) + (should (equal image '(image :rotation 90.0))) + (image-rotate 0) + (should (equal image '(image :rotation 90.0))) + (image-rotate 1) + (should (equal image '(image :rotation 91.0))) + (image-rotate 1234.5) + (should (equal image '(image :rotation 245.5))) + (image-rotate -154.5) + (should (equal image '(image :rotation 91.0))))) + +;;; image-tests.el ends here diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 51b2ca0cd51..0fd8e1db49e 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -24,6 +24,7 @@ ;; module in test/data/emacs-module. ;;; Code: +;;; Prelude (require 'cl-lib) (require 'ert) @@ -48,9 +49,7 @@ (cl-defmethod emacs-module-tests--generic ((_ user-ptr)) 'user-ptr) -;; -;; Basic tests. -;; +;;; Basic tests (ert-deftest mod-test-sum-test () (should (= (mod-test-sum 1 2) 3)) @@ -103,9 +102,7 @@ changes." ">" eos) (prin1-to-string func))))) -;; -;; Non-local exists (throw, signal). -;; +;;; Non-local exists (throw, signal) (ert-deftest mod-test-non-local-exit-signal-test () (should-error (mod-test-signal)) @@ -142,9 +139,7 @@ changes." (should (equal (mod-test-non-local-exit-funcall (lambda () (throw 'tag 32))) '(throw tag 32)))) -;; -;; String tests. -;; +;;; String tests (defun multiply-string (s n) "Return N copies of S concatenated together." @@ -168,9 +163,7 @@ changes." (ert-deftest mod-test-string-a-to-b-test () (should (string= (mod-test-string-a-to-b "aaa") "bbb"))) -;; -;; User-pointer tests. -;; +;;; User-pointer tests (ert-deftest mod-test-userptr-fun-test () (let* ((n 42) @@ -184,9 +177,7 @@ changes." ;; TODO: try to test finalizer -;; -;; Vector tests. -;; +;;; Vector tests (ert-deftest mod-test-vector-test () (dolist (s '(2 10 100 1000)) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index f1faf58659a..400e9126486 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -895,3 +895,9 @@ ;; This does not test randomness; it's merely a format check. (should (string-match "\\`[0-9a-f]\\{128\\}\\'" (secure-hash 'sha512 'iv-auto 100)))) + +(ert-deftest test-vector-delete () + (let ((v1 (make-vector 1000 1))) + (should (equal (delete t [nil t]) [nil])) + (should (equal (delete 1 v1) (vector))) + (should (equal (delete 2 v1) v1)))) |