diff options
| author | Ken Raeburn <raeburn@raeburn.org> | 2017-07-31 01:13:53 -0400 |
|---|---|---|
| committer | Ken Raeburn <raeburn@raeburn.org> | 2017-07-31 01:13:53 -0400 |
| commit | 13f3370400031e2ac1c9be0932f411370fc6984e (patch) | |
| tree | 06f349b2b0f1cda9e36f7c4390d9d2d9bf49303c | |
| parent | cd0966b33c1fe975520e85e0e7af82c09e4754dc (diff) | |
| parent | dcfcaf40d577808d640016c886d4fae7280a7fd5 (diff) | |
| download | emacs-scratch/raeburn-startup.tar.gz | |
; Merge from branch 'master'scratch/raeburn-startup
90 files changed, 1701 insertions, 651 deletions
diff --git a/.gitignore b/.gitignore index 46ed4a137de..9229297833a 100644 --- a/.gitignore +++ b/.gitignore @@ -111,7 +111,6 @@ lisp/mh-e/mh-autoloads.el lisp/subdirs.el # Dependencies. -.deps/ deps/ # Logs and temporaries. @@ -138,6 +137,7 @@ gmon.out oo/ oo-spd/ src/*.map +vgcore.*[0-9] # Tests. test/manual/biditest.txt diff --git a/CONTRIBUTE b/CONTRIBUTE index 3ed587c6918..365e4232499 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -26,6 +26,7 @@ admin/notes/git-workflow. ** Getting involved with development +Discussion about Emacs development takes place on emacs-devel@gnu.org. You can subscribe to the emacs-devel@gnu.org mailing list, paying attention to postings with subject lines containing "emacs-announce", as these discuss important events like feature freezes. See @@ -35,11 +36,85 @@ own copy of the repository, and discuss proposed changes on the mailing list. Frequent contributors to Emacs can request write access there. -** Committing changes by others +Bug reports and fixes, feature requests and patches/implementations +should be sent to bug-gnu-emacs@gnu.org, the bug/feature list. This +is coupled to the http://debbugs.gnu.org tracker. It is best to use +the command 'M-x report-emacs-bug RET' to report issues to the tracker +(described below). Be prepared to receive comments and requests for +changes in your patches, following your submission. -If committing changes written by someone else, commit in their name, -not yours. You can use 'git commit --author="AUTHOR"' to specify a -change's author. +The Savannah info page http://savannah.gnu.org/mail/?group=emacs +describes how to subscribe to the mailing lists, or see the list +archives. + +To email a patch you can use a shell command like 'git format-patch -1' +to create a file, and then attach the file to your email. This nicely +packages the patch's commit message and changes. To send just one +such patch without additional remarks, you can use a command like +'git send-email --to=bug-gnu-emacs@gnu.org 0001-DESCRIPTION.patch'. + +** Issue tracker (a.k.a. "bug tracker") + +The Emacs issue tracker at http://debbugs.gnu.org lets you view bug +reports and search the database for bugs matching several criteria. +Messages posted to the bug-gnu-emacs@gnu.org mailing list, mentioned +above, are recorded by the tracker with the corresponding bugs/issues. + +GNU ELPA has a 'debbugs' package that allows accessing the tracker +database from Emacs. + +Bugs needs regular attention. A large backlog of bugs is +disheartening to the developers, and a culture of ignoring bugs is +harmful to users, who expect software that works. Bugs have to be +regularly looked at and acted upon. Not all bugs are critical, but at +the least, each bug needs to be regularly re-reviewed to make sure it +is still reproducible. + +The process of going through old or new bugs and acting on them is +called bug triage. This process is described in the file +admin/notes/bug-triage. + +** Documenting your changes + +Any change that matters to end-users should have an entry in etc/NEWS. + +Doc-strings should be updated together with the code. + +Think about whether your change requires updating the manuals. If you +know it does not, mark the NEWS entry with "---". If you know +that *all* the necessary documentation updates have been made, mark +the entry with "+++". Otherwise do not mark it. + +If your change requires updating the manuals to document new +functions/commands/variables/faces, then use the proper Texinfo +command to index them; for instance, use @vindex for variables and +@findex for functions/commands. For the full list of predefine indices, see +http://www.gnu.org/software/texinfo/manual/texinfo/html_node/Predefined-Indices.html +or run the shell command 'info "(texinfo)Predefined Indices"'. + +For more specific tips on Emacs's doc style, see +http://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html +Use 'checkdoc' to check for documentation errors before submitting a patch. + +** Testing your changes + +Please test your changes before committing them or sending them to the +list. If possible, add a new test along with any bug fix or new +functionality you commit (of course, some changes cannot be easily +tested). + +Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See +http://www.gnu.org/software/emacs/manual/html_node/ert/ +or run 'info "(ert)"' for for more information on writing and running +tests. + +If your test lasts longer than some few seconds, mark it in its +'ert-deftest' definition with ":tags '(:expensive-test)". + +To run tests on the entire Emacs tree, run "make check" from the +top-level directory. Most tests are in the directory "test/". From +the "test/" directory, run "make <filename>" to run the tests for +<filename>.el(c). See "test/README" for more information. ** Commit messages @@ -176,6 +251,12 @@ them right the first time, so here are guidelines for formatting them: with Emacs commands like 'C-x 4 a', and commit the change using the shell command 'vc-dwim --commit'. Type 'vc-dwim --help' for more. +** Committing changes by others + +If committing changes written by someone else, commit in their name, +not yours. You can use 'git commit --author="AUTHOR"' to specify a +change's author. + ** Branches Future development normally takes place on the master branch. @@ -218,87 +299,6 @@ This repository does not contain the Emacs Lisp package archive (elpa.gnu.org). See admin/notes/elpa for how to access the GNU ELPA repository. -** Emacs Mailing lists. - -Discussion about Emacs development takes place on emacs-devel@gnu.org. - -Bug reports and fixes, feature requests and implementations should be -sent to bug-gnu-emacs@gnu.org, the bug/feature list. This is coupled -to the http://debbugs.gnu.org tracker. - -The Savannah info page http://savannah.gnu.org/mail/?group=emacs -describes how to subscribe to the mailing lists, or see the list -archives. - -To email a patch you can use a shell command like 'git format-patch -1' -to create a file, and then attach the file to your email. This nicely -packages the patch's commit message and changes. To send just one -such patch without additional remarks, you can use a command like -'git send-email --to=bug-gnu-emacs@gnu.org 0001-DESCRIPTION.patch'. - -** Issue tracker (a.k.a. "bug tracker") - -The Emacs issue tracker at http://debbugs.gnu.org lets you view bug -reports and search the database for bugs matching several criteria. -Messages posted to the bug-gnu-emacs@gnu.org mailing list, mentioned -above, are recorded by the tracker with the corresponding bugs/issues. - -GNU ELPA has a 'debbugs' package that allows accessing the tracker -database from Emacs. - -Bugs needs regular attention. A large backlog of bugs is -disheartening to the developers, and a culture of ignoring bugs is -harmful to users, who expect software that works. Bugs have to be -regularly looked at and acted upon. Not all bugs are critical, but at -the least, each bug needs to be regularly re-reviewed to make sure it -is still reproducible. - -The process of going through old or new bugs and acting on them is -called bug triage. This process is described in the file -admin/notes/bug-triage. - -** Documenting your changes - -Any change that matters to end-users should have an entry in etc/NEWS. - -Doc-strings should be updated together with the code. - -Think about whether your change requires updating the manuals. If you -know it does not, mark the NEWS entry with "---". If you know -that *all* the necessary documentation updates have been made, mark -the entry with "+++". Otherwise do not mark it. - -If your change requires updating the manuals to document new -functions/commands/variables/faces, then use the proper Texinfo -command to index them; for instance, use @vindex for variables and -@findex for functions/commands. For the full list of predefine indices, see -http://www.gnu.org/software/texinfo/manual/texinfo/html_node/Predefined-Indices.html -or run the shell command 'info "(texinfo)Predefined Indices"'. - -For more specific tips on Emacs's doc style, see -http://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html -Use 'checkdoc' to check for documentation errors before submitting a patch. - -** Testing your changes - -Please test your changes before committing them or sending them to the -list. If possible, add a new test along with any bug fix or new -functionality you commit (of course, some changes cannot be easily -tested). - -Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See -http://www.gnu.org/software/emacs/manual/html_node/ert/ -or run 'info "(ert)"' for for more information on writing and running -tests. - -If your test lasts longer than some few seconds, mark it in its -'ert-deftest' definition with ":tags '(:expensive-test)". - -To run tests on the entire Emacs tree, run "make check" from the -top-level directory. Most tests are in the directory "test/". From -the "test/" directory, run "make <filename>" to run the tests for -<filename>.el(c). See "test/README" for more information. - ** Understanding Emacs internals The best way to understand Emacs internals is to read the code. Some diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 2b1a16a10ec..18c9ee8def7 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -35,10 +35,10 @@ GNULIB_MODULES=' filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat - manywarnings memrchr minmax mkostemp mktime + manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio - stpcpy strftime strtoimax symlink sys_stat + stpcpy strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright unlocked-io utimens vla warnings diff --git a/build-aux/config.guess b/build-aux/config.guess index 2193702b12a..07785f54515 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2017 Free Software Foundation, Inc. -timestamp='2017-05-27' +timestamp='2017-07-19' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1429,8 +1429,8 @@ cat >&2 <<EOF $0: unable to guess system type This script (version $timestamp), has failed to recognize the -operating system you are using. If your script is old, overwrite -config.guess and config.sub with the latest versions from: +operating system you are using. If your script is old, overwrite *all* +copies of config.guess and config.sub with the latest versions from: http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess and diff --git a/configure.ac b/configure.ac index 7aaf772a1be..144d6881fe6 100644 --- a/configure.ac +++ b/configure.ac @@ -175,6 +175,7 @@ esac canonical=$host configuration=${host_alias-${build_alias-$host}} +emacs_uname_r=`uname -r` dnl Support for --program-prefix, --program-suffix and dnl --program-transform-name options @@ -352,7 +353,8 @@ OPTION_DEFAULT_OFF([w32], [use native MS Windows GUI in a Cygwin build]) OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console]) OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) -OPTION_DEFAULT_ON([gconf],[don't compile with GConf support]) +AC_ARG_WITH([gconf],[AS_HELP_STRING([--with-gconf], +[compile with Gconf support (Gsettings replaces this)])],[],[with_gconf=maybe]) OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings support]) OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) @@ -1221,8 +1223,8 @@ if test $opsys = gnu-linux; then AC_SUBST([SETFATTR]) fi fi -case $opsys,$PAXCTL_notdumped in - gnu-linux, | netbsd,) +case $opsys,$PAXCTL_notdumped,$emacs_uname_r in + gnu-linux,,* | netbsd,,[0-7].*) AC_PATH_PROG([PAXCTL], [paxctl], [], [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) if test -n "$PAXCTL"; then @@ -2503,7 +2505,8 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" if test "${with_imagemagick}" != "no"; then ## 6.3.5 is the earliest version known to work; see Bug#17339. ## 6.8.2 makes Emacs crash; see Bug#13867. - IMAGEMAGICK_MODULE="Wand >= 6.3.5 Wand != 6.8.2" + ## 7 and later have not been ported to; See Bug#25967. + IMAGEMAGICK_MODULE="Wand >= 6.3.5 Wand != 6.8.2 Wand < 7" EMACS_CHECK_MODULES([IMAGEMAGICK], [$IMAGEMAGICK_MODULE]) if test $HAVE_IMAGEMAGICK = yes; then @@ -2772,6 +2775,7 @@ if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then AC_DEFINE(HAVE_GSETTINGS, 1, [Define to 1 if using GSettings.]) SETTINGS_CFLAGS="$GSETTINGS_CFLAGS" SETTINGS_LIBS="$GSETTINGS_LIBS" + test "$with_gconf" = "yes" || with_gconf=no fi CFLAGS=$old_CFLAGS LIBS=$old_LIBS @@ -2781,7 +2785,7 @@ fi dnl GConf has been tested under GNU/Linux only. dnl The version is really arbitrary, it is about the same age as Gtk+ 2.6. HAVE_GCONF=no -if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then +if test "${HAVE_X11}" = "yes" && test "${with_gconf}" != "no"; then EMACS_CHECK_MODULES([GCONF], [gconf-2.0 >= 2.13]) if test "$HAVE_GCONF" = yes; then AC_DEFINE(HAVE_GCONF, 1, [Define to 1 if using GConf.]) @@ -3554,27 +3558,22 @@ AC_SUBST(LIBZ) LIBMODULES= HAVE_MODULES=no MODULES_OBJ= -MODULES_SUFFIX= +case $opsys in + cygwin|mingw32) MODULES_SUFFIX=".dll" ;; + *) MODULES_SUFFIX=".so" ;; +esac if test "${with_modules}" != "no"; then case $opsys in gnu|gnu-linux) LIBMODULES="-ldl" - MODULES_SUFFIX=".so" - HAVE_MODULES=yes - ;; - cygwin|mingw32) - MODULES_SUFFIX=".dll" HAVE_MODULES=yes ;; - darwin) - MODULES_SUFFIX=".so" + cygwin|mingw32|darwin) HAVE_MODULES=yes ;; *) # BSD systems have dlopen in libc. - AC_CHECK_FUNC([dlopen], - [MODULES_SUFFIX=".so" - HAVE_MODULES=yes]) + AC_CHECK_FUNC([dlopen], [HAVE_MODULES=yes]) ;; esac @@ -5461,7 +5460,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use a png library? ${HAVE_PNG} $LIBPNG Does Emacs use -lrsvg-2? ${HAVE_RSVG} Does Emacs use cairo? ${HAVE_CAIRO} - Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK} + Does Emacs use imagemagick (version 6)? ${HAVE_IMAGEMAGICK} Does Emacs support sound? ${HAVE_SOUND} Does Emacs use -lgpm? ${HAVE_GPM} Does Emacs use -ldbus? ${HAVE_DBUS} @@ -5508,13 +5507,12 @@ to run if these resources are not installed."]) echo fi -if test "${opsys}" = "cygwin"; then - case `uname -r` in - 1.5.*) AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]]) +case $opsys,$emacs_uname_r in + cygwin,1.5.*) + AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]]) echo ;; - esac -fi +esac # Remove any trailing slashes in these variables. case $prefix in diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index a756a89e3f8..1c9c14a962a 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1701,6 +1701,7 @@ and mouse events: (global-set-key (kbd "C-c y") 'clipboard-yank) (global-set-key (kbd "C-M-q") 'query-replace) (global-set-key (kbd "<f5>") 'flyspell-mode) +(global-set-key (kbd "C-<f5>") 'display-line-numbers-mode) (global-set-key (kbd "C-<right>") 'forward-sentence) (global-set-key (kbd "<mouse-2>") 'mouse-save-then-kill) @end example diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index ddd7229b0c8..150ac8427ab 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -64,10 +64,22 @@ you to operate on the listed files. @xref{Directories}. directory name using the minibuffer, and opens a @dfn{Dired buffer} listing the files in that directory. You can also supply a wildcard file name pattern as the minibuffer argument, in which case the Dired -buffer lists all files matching that pattern. The usual history and -completion commands can be used in the minibuffer; in particular, -@kbd{M-n} puts the name of the visited file (if any) in the minibuffer -(@pxref{Minibuffer History}). +buffer lists all files matching that pattern. A wildcard may appear +in the directory part as well. +For instance, + +@example +C-x d ~/foo/*.el @key{RET} +C-x d ~/foo/*/*.el @key{RET} +@end example + +The former lists all the files with extension @samp{.el} in directory +@samp{foo}. The latter lists the files with extension @samp{.el} +in subdirectories 2 levels of depth below @samp{foo}. + +The usual history and completion commands can be used in the minibuffer; +in particular, @kbd{M-n} puts the name of the visited file (if any) in +the minibuffer (@pxref{Minibuffer History}). You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file}) a directory name. diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 2ba3e26c484..f833f572dfc 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -254,6 +254,7 @@ Restart the Aspell/Ispell/Hunspell process, using @var{dict} as the dictionary. Kill the Aspell/Ispell/Hunspell subprocess. @item M-@key{TAB} @itemx @key{ESC} @key{TAB} +@itemx C-M-i Complete the word before point based on the spelling dictionary (@code{ispell-complete-word}). @item M-x flyspell-mode diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index e3e59ad43ac..ee33a6848c5 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -575,7 +575,8 @@ font names in X resource files. If you are running Emacs on the GNOME desktop, you can tell Emacs to use the default system font by setting the variable @code{font-use-system-font} to @code{t} (the default is @code{nil}). -For this to work, Emacs must have been compiled with Gconf support. +For this to work, Emacs must have been compiled with support for +Gsettings (or the older Gconf). @item Use the command line option @samp{-fn} (or @samp{--font}). @xref{Font diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index fd6df1c7e53..460ced0d21c 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -320,12 +320,21 @@ search for non-customizable variables too. Search for variables. With a prefix argument, search for customizable variables only. +@item M-x apropos-local-variable +@findex apropos-local-variable +Search for buffer-local variables. + @item M-x apropos-value @findex apropos-value Search for variables whose values match the specified pattern. With a prefix argument, search also for functions with definitions matching the pattern, and Lisp symbols with properties matching the pattern. +@item M-x apropos-local-value +@findex apropos-local-value +Search for buffer-local variables whose values match the specified +pattern. + @item C-h d @kindex C-h d @findex apropos-documentation diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index eb0c88b2901..876431aa9e9 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -225,6 +225,13 @@ Font-Lock mode automatically highlights certain textual units found in programs. It is enabled globally by default, but you can disable it in individual buffers. @xref{Faces}. +@findex display-line-numbers-mode +@cindex display-line-numbers-mode +@item +Display Line Numbers mode is a convenience wrapper around +@code{display-line-numbers}, setting it using the value of +@code{display-line-numbers-type}. @xref{Display Custom}. + @item Outline minor mode provides similar facilities to the major mode called Outline mode. @xref{Outline Mode}. diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index 7369f6b05b6..40e3e2c1c31 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -15,7 +15,10 @@ jump back to that position once, or many times. Each register has a name that consists of a single character, which we will denote by @var{r}; @var{r} can be a letter (such as @samp{a}) or a number (such as @samp{1}); case matters, so register @samp{a} is -not the same as register @samp{A}. +not the same as register @samp{A}. You can also set a register in +non-alphanumeric characters, for instance @samp{*} or @samp{C-d}. +Note, it's not possible to set a register in @samp{C-g} or @samp{ESC}, +because these keys are reserved to terminate interactive commands. @findex view-register A register can store a position, a piece of text, a rectangle, a diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index c9e83da173f..9f7e9a12cd7 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1747,6 +1747,10 @@ at the first match after such line. You can also run @kbd{M-s o} when an incremental search is active; this uses the current search string. +Note that matches for the regexp you type are extended to include +complete lines, and a match that starts before the previous match ends +is not considered a match. + @kindex RET @r{(Occur mode)} @kindex o @r{(Occur mode)} @kindex C-o @r{(Occur mode)} diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 7e27ddd1d9a..eaefcee21c3 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -250,6 +250,11 @@ specified if @samp{off}. Gamma correction for colors, equivalent to the frame parameter @code{screen-gamma}. +@item @code{scrollBar} (class @code{ScrollBar}) +@cindex tool bar +If the value of this resource is @samp{off} or @samp{false} or +@samp{0}, Emacs disables Scroll Bar mode at startup (@pxref{Scroll Bars}). + @item @code{scrollBarWidth} (class @code{ScrollBarWidth}) @cindex scrollbar width The scroll bar width in pixels, equivalent to the frame parameter diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index f5c73e55a4f..2ed848adf37 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2423,7 +2423,9 @@ the values of the @code{:family}, @code{:foundry}, @code{:width}, The name of a face from which to inherit attributes, or a list of face names. Attributes from inherited faces are merged into the face like an underlying face would be, with higher priority than underlying -faces (@pxref{Displaying Faces}). If a list of faces is used, +faces (@pxref{Displaying Faces}). If the face to inherit from is +@code{unspecified}, it is treated the same as @code{nil}, since Emacs +never merges @code{:inherit} attributes. If a list of faces is used, attributes from faces earlier in the list override those from later faces. @end table diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index d925c8c8f65..80dcb488983 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -468,6 +468,10 @@ runs the real definition as if it had been loaded all along. Autoloading can also be triggered by looking up the documentation of the function or macro (@pxref{Documentation Basics}). +@menu +* When to Autoload:: When to Use Autoload. +@end menu + There are two ways to set up an autoloaded function: by calling @code{autoload}, and by writing a ``magic'' comment in the source before the real definition. @code{autoload} is the low-level @@ -699,6 +703,42 @@ symbol's new function value. If the value of the optional argument function, only a macro. @end defun +@node When to Autoload +@subsection When to Use Autoload +@cindex autoload, when to use + +Do not add an autoload comment unless it is really necessary. +Autoloading code means it is always globally visible. Once an item is +autoloaded, there is no compatible way to transition back to it not +being autoloaded (after people become accustomed to being able to use it +without an explicit load). + +@itemize +@item +The most common items to autoload are the interactive entry points to a +library. For example, if @file{python.el} is a library defining a +major-mode for editing Python code, autoload the definition of the +@code{python-mode} function, so that people can simply use @kbd{M-x +python-mode} to load the library. + +@item +Variables usually don't need to be autoloaded. An exception is if the +variable on its own is generally useful without the whole defining +library being loaded. (An example of this might be something like +@code{find-exec-terminator}.) + +@item +Don't autoload a user option just so that a user can set it. + +@item +Never add an autoload @emph{comment} to silence a compiler warning in +another file. In the file that produces the warning, use +@code{(defvar foo)} to silence an undefined variable warning, and +@code{declare-function} (@pxref{Declaring Functions}) to silence an +undefined function warning; or require the relevant library; or use an +explicit autoload @emph{statement}. +@end itemize + @node Repeated Loading @section Repeated Loading @cindex repeated loading diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 7108520e79f..b825b1d790b 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4236,6 +4236,7 @@ A marker represents a buffer position to jump to. A string is text saved in the register. @item a rectangle +@cindex rectangle, as contents of a register A rectangle is represented by a list of strings. @item @code{(@var{window-configuration} @var{position})} @@ -97,6 +97,10 @@ Terminal is automatically initialized to use 24-bit colors if the required capabilities are found in terminfo. See the FAQ node "Colors on a TTY" for more information. ++++ +** Emacs now obeys the X resource "scrollBar" at startup. +The effect is similar to that of "toolBar" resource on the tool bar. + * Changes in Emacs 26.1 @@ -434,13 +438,18 @@ range of indentation. This is similar to what linum-mode provides, but much faster and doesn't usurp the display margin for the line numbers. Customize the buffer-local variable 'display-line-numbers' to activate this optional -display. If set to t, Emacs will display the number of each line -before the line. If set to 'relative', Emacs will display the line -number relative to the line showing point, with that line's number -displayed as absolute. If set to 'visual', Emacs will display a -relative number for every screen line, i.e. it will count screen lines -rather than buffer lines. The default is nil, which doesn't display -the line numbers. +display. Alternatively, you can use the `display-line-numbers-mode' +minor mode or the global `global-display-line-numbers-mode'. When +using these modes, customize `display-line-numbers-type' with the same +value as you would use with `display-line-numbers'. + +If `display-line-numbers' is set to t, Emacs will display the number +of each line before the line. If set to 'relative', Emacs will +display the line number relative to the line showing point, with that +line's number displayed as absolute. If set to 'visual', Emacs will +display a relative number for every screen line, i.e. it will count +screen lines rather than buffer lines. The default is nil, which +doesn't display the line numbers. In 'relative' and 'visual' modes, the variable 'display-line-numbers-current-absolute' controls what number is @@ -458,14 +467,23 @@ new face 'line-number-current-line' can be customized to display the current line's number differently from all the other line numbers; by default these two faces are identical. -You can also customize the new variable 'display-line-numbers-width' to -specify a fixed minimal with of the area allocated to line-number -display. The default is nil, meaning that Emacs will dynamically -calculate the area width, enlarging or shrinking it as needed. -Setting it to a non-negative integer specifies that as the minimal -width; selecting a value that is large enough to display all line -numbers in a buffer will then keep the line-number display area of -constant width at all times, if that is desired. +You can also customize the new buffer-local variable +'display-line-numbers-width' to specify a fixed minimal with of the +area allocated to line-number display. The default is nil, meaning +that Emacs will dynamically calculate the area width, enlarging or +shrinking it as needed. Setting it to a non-negative integer +specifies that as the minimal width; selecting a value that is large +enough to display all line numbers in a buffer will then keep the +line-number display area of constant width at all times, if that is +desired. + +When using `display-line-numbers-mode', you can customize the variable +`display-line-numbers-grow-only' to a non-nil value; this means that +Emacs may grow the above area width dynamically, but never shrink it. +Under this mode, customizing the variable +`display-line-numbers-width-start' to a non-nil value will cause Emacs +to set `display-line-numbers-width' to the minimum width necessary to +display all line numbers in the current buffer when first visiting it. Lisp programs can disable line-number display for a particular screen line by putting the 'display-line-numbers-disable' text property or @@ -572,6 +590,12 @@ different buffer while keeping point, mark, markers, and text properties as intact as possible. +++ +** New commands 'apropos-local-variable' and 'apropos-local-value. +These are buffer-local versions of 'apropos-variable' and +'apropos-value', respectively. They show buffer-local variables whose +names and values, respectively, match a given pattern. + ++++ ** More user control of reordering bidirectional text for display. The two new variables, 'bidi-paragraph-start-re' and 'bidi-paragraph-separate-re', allow customization of what exactly are @@ -580,9 +604,14 @@ paragraphs, for the purposes of bidirectional display. * Changes in Specialized Modes and Packages in Emacs 26.1 +** New function `cl-generic-p'. + ** Dired +++ +*** Dired supports wildcards in the directory part of the file names. + ++++ *** You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced by the current file name. @@ -1058,6 +1087,9 @@ fontification, and commenting for embedded JavaScript and CSS. * Incompatible Lisp Changes in Emacs 26.1 +*** password-data is now a hash-table +so that `password-read' can use any object for the `key' argument. + +++ *** Command 'dired-mark-extension' now automatically prepends a '.' to the extension when not present. The new command 'dired-mark-suffix' behaves @@ -1136,6 +1168,10 @@ instead of its first. renamed to 'lread--old-style-backquotes'. No user code should use this variable. +** To avoid confusion caused by "smart quotes", the reader no longer +accepts Lisp symbols which begin with the following quotation +characters: ‘’‛“”‟〞＂＇, unless they are escaped with backslash. + +++ ** Module functions are now implemented slightly differently; in particular, the function 'internal--module-call' has been removed. @@ -1145,6 +1181,8 @@ break. * Lisp Changes in Emacs 26.1 +** New function `define-symbol-prop'. + +++ ** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'. @@ -1533,6 +1571,9 @@ manual. ** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality can be replicated simply by setting 'comment-auto-fill-only-comments'. +** New pcase pattern 'rx' to match against a rx-style regular +expression. + * Changes in Emacs 26.1 on Non-Free Operating Systems @@ -1578,6 +1619,9 @@ debugger has been attached to it. ** 'set-mouse-position' and 'set-mouse-absolute-pixel-position' work on macOS. +** Emacs can now be run as a GUI application from the command line on +macOS. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 6b2cc110403..ecd6447ab78 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -667,7 +667,9 @@ close_emacs_globals (ptrdiff_t num_symbols) "#ifndef DEFINE_SYMBOLS\n" "extern\n" "#endif\n" - "struct Lisp_Symbol alignas (GCALIGNMENT) lispsym[%td];\n"), + "struct {\n" + " struct Lisp_Symbol alignas (GCALIGNMENT) s;\n" + "} lispsym[%td];\n"), num_symbols); } diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index e20487b10b4..3e57391372a 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings +# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings MOSTLYCLEANFILES += core *.stackdump @@ -1811,6 +1811,16 @@ EXTRA_libgnu_a_SOURCES += mktime.c endif ## end gnulib module mktime-internal +## begin gnulib module nstrftime +ifeq (,$(OMIT_GNULIB_MODULE_nstrftime)) + +libgnu_a_SOURCES += nstrftime.c + +EXTRA_DIST += strftime.h + +endif +## end gnulib module nstrftime + ## begin gnulib module openat-h ifeq (,$(OMIT_GNULIB_MODULE_openat-h)) @@ -2399,16 +2409,6 @@ EXTRA_libgnu_a_SOURCES += stpcpy.c endif ## end gnulib module stpcpy -## begin gnulib module strftime -ifeq (,$(OMIT_GNULIB_MODULE_strftime)) - -libgnu_a_SOURCES += strftime.c - -EXTRA_DIST += strftime.h - -endif -## end gnulib module strftime - ## begin gnulib module string ifeq (,$(OMIT_GNULIB_MODULE_string)) diff --git a/lib/strftime.c b/lib/nstrftime.c index 99bee4ef978..99bee4ef978 100644 --- a/lib/strftime.c +++ b/lib/nstrftime.c diff --git a/lisp/apropos.el b/lisp/apropos.el index cbd9c71d3e3..86d9b514290 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -514,6 +514,19 @@ options only, i.e. behave like `apropos-user-option'." (let ((apropos-do-all (if do-not-all nil t))) (apropos-user-option pattern))) +;;;###autoload +(defun apropos-local-variable (pattern &optional buffer) + "Show buffer-local variables that match PATTERN. +Optional arg BUFFER (default: current buffer) is the buffer to check. + +The output includes variables that are not yet set in BUFFER, but that +will be buffer-local when set." + (interactive (list (apropos-read-pattern "buffer-local variable"))) + (unless buffer (setq buffer (current-buffer))) + (apropos-command pattern nil (lambda (symbol) + (and (local-variable-if-set-p symbol) + (get symbol 'variable-documentation))))) + ;; For auld lang syne: ;;;###autoload (defalias 'command-apropos 'apropos-command) @@ -795,6 +808,35 @@ Returns list of symbols and values found." (let ((apropos-multi-type do-all)) (apropos-print nil "\n----------------\n"))) +;;;###autoload +(defun apropos-local-value (pattern &optional buffer) + "Show buffer-local variables whose values match PATTERN. +This is like `apropos-value', but only for buffer-local variables. +Optional arg BUFFER (default: current buffer) is the buffer to check." + (interactive (list (apropos-read-pattern "value of buffer-local variable"))) + (unless buffer (setq buffer (current-buffer))) + (apropos-parse-pattern pattern) + (setq apropos-accumulator ()) + (let ((var nil)) + (mapatoms + (lambda (symb) + (unless (memq symb '(apropos-regexp apropos-pattern apropos-all-words-regexp + apropos-words apropos-all-words apropos-accumulator symb var)) + (setq var (apropos-value-internal 'local-variable-if-set-p symb 'symbol-value))) + (when (and (fboundp 'apropos-false-hit-str) (apropos-false-hit-str var)) + (setq var nil)) + (when var + (setq apropos-accumulator (cons (list symb (apropos-score-str var) nil var) + apropos-accumulator)))))) + (let ((apropos-multi-type nil)) + (if (> emacs-major-version 20) + (apropos-print + nil "\n----------------\n" + (format "Buffer `%s' has the following local variables\nmatching %s`%s':" + (buffer-name buffer) + (if (consp pattern) "keywords " "") + pattern)) + (apropos-print nil "\n----------------\n")))) ;;;###autoload (defun apropos-documentation (pattern &optional do-all) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index d1747bda3da..d4b44a59529 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -200,8 +200,6 @@ Note that if EPA/EPG is not available, this should NOT be used." (const :tag "Save GPG-encrypted password tokens" gpg) (const :tag "Don't encrypt tokens" never)))))) -(defvar auth-source-magic "auth-source-magic ") - (defcustom auth-source-do-cache t "Whether auth-source should cache information with `password-cache'." :group 'auth-source @@ -782,16 +780,16 @@ Returns the deleted entries." (defun auth-source-forget-all-cached () "Forget all cached auth-source data." (interactive) - (cl-do-symbols (sym password-data) - ;; when the symbol name starts with auth-source-magic - (when (string-match (concat "^" auth-source-magic) (symbol-name sym)) - ;; remove that key - (password-cache-remove (symbol-name sym)))) + (maphash (lambda (key _password) + (when (eq 'auth-source (car-safe key)) + ;; remove that key + (password-cache-remove key))) + password-data) (setq auth-source-netrc-cache nil)) (defun auth-source-format-cache-entry (spec) "Format SPEC entry to put it in the password cache." - (concat auth-source-magic (format "%S" spec))) + `(auth-source . ,spec)) (defun auth-source-remember (spec found) "Remember FOUND search results for SPEC." @@ -822,18 +820,16 @@ This is not a full `auth-source-search' spec but works similarly. For instance, \(:host \"myhost\" \"yourhost\") would find all the cached data that was found with a search for those two hosts, while \(:host t) would find all host entries." - (let ((count 0) - sname) - (cl-do-symbols (sym password-data) - ;; when the symbol name matches with auth-source-magic - (when (and (setq sname (symbol-name sym)) - (string-match (concat "^" auth-source-magic "\\(.+\\)") - sname) - ;; and the spec matches what was stored in the cache - (auth-source-specmatchp spec (read (match-string 1 sname)))) - ;; remove that key - (password-cache-remove sname) - (cl-incf count))) + (let ((count 0)) + (maphash + (lambda (key _password) + (when (and (eq 'auth-source (car-safe key)) + ;; and the spec matches what was stored in the cache + (auth-source-specmatchp spec (cdr key))) + ;; remove that key + (password-cache-remove key) + (cl-incf count))) + password-data) count)) (defun auth-source-specmatchp (spec stored) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index b89c1c2bbd5..1cb01e1ed9e 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -4527,11 +4527,9 @@ If the file already exists, overwrite it only on confirmation." (defcustom todo-print-buffer-function #'ps-print-buffer-with-faces "Function called by `todo-print-buffer' to print Todo mode buffers. -The function should take an optional argument whose non-nil value -is a string naming a file to save the print image to; calling -`todo-print-buffer-to-file' prompts for the file name, which is -passed to this function. Calling this function with no or a nil -argument sends the image to the printer." +Called with one argument which can either be: +- a string, naming a file to save the print image to. +- nil, to send the image to the printer." :type 'symbol :group 'todo) diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 42dc40cce04..df71508da7c 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -189,26 +189,25 @@ This shell should support pipe redirect syntax." ;; Return the answer ans)) -(defconst semantic-symref-grep--line-re - "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):") - (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." - (cond ((eq (oref tool :resulttype) 'file) - ;; Search for files - (when (re-search-forward "^\\([^\n]+\\)$" nil t) - (match-string 1))) - ((eq (oref tool :resulttype) 'line-and-text) - (when (re-search-forward semantic-symref-grep--line-re nil t) - (list (string-to-number (match-string 2)) - (match-string 1) - (buffer-substring-no-properties (point) (line-end-position))))) - (t - (when (re-search-forward semantic-symref-grep--line-re nil t) - (cons (string-to-number (match-string 2)) - (match-string 1)) - )))) + (pcase-let + ((`(,grep-re ,file-group ,line-group . ,_) (car (grep-regexp-alist)))) + (cond ((eq (oref tool :resulttype) 'file) + ;; Search for files + (when (re-search-forward "^\\([^\n]+\\)$" nil t) + (match-string 1))) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward grep-re nil t) + (list (string-to-number (match-string line-group)) + (match-string file-group) + (buffer-substring-no-properties (point) (line-end-position))))) + (t + (when (re-search-forward grep-re nil t) + (cons (string-to-number (match-string line-group)) + (match-string file-group)) + ))))) (provide 'semantic/symref/grep) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index ed913e32688..c28b8a147fc 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -584,7 +584,7 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Grow only" :value grow-only)) "25.1") (display-raw-bytes-as-hex display boolean "26.1") - (display-line-numbers display + (display-line-numbers display-line-numbers (choice (const :tag "Off (nil)" :value nil) (const :tag "Absolute line numbers" @@ -594,7 +594,7 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Visually relative line numbers" :value visual)) "26.1") - (display-line-numbers-width display + (display-line-numbers-width display-line-numbers (choice (const :tag "Dynamically computed" :value nil) @@ -602,14 +602,14 @@ since it could result in memory overflow and make Emacs crash." :value 2 :format "%v")) "26.1") - (display-line-numbers-current-absolute display + (display-line-numbers-current-absolute display-line-numbers (choice (const :tag "Display actual number of current line" :value t) (const :tag "Display zero as number of current line" :value nil)) "26.1") - (display-line-numbers-widen display + (display-line-numbers-widen display-line-numbers (choice (const :tag "Disregard narrowing when calculating line numbers" :value t) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 17dae6085df..0a8ec26f7ca 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,4 +1,4 @@ -;;; dired-aux.el --- less commonly used parts of dired +;;; dired-aux.el --- less commonly used parts of dired -*- lexical-binding: t -*- ;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2017 Free Software ;; Foundation, Inc. @@ -742,8 +742,6 @@ can be produced by `dired-get-marked-files', for example." (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) - (star (string-match "\\*" command)) - (qmark (string-match "\\?" command)) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. (ok (cond ((not (or on-each no-subst)) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 915550991d0..1425278bdc9 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1629,10 +1629,11 @@ Binding direction based on `dired-x-hands-off-my-keys'." (if (called-interactively-p 'interactive) (setq dired-x-hands-off-my-keys (not (y-or-n-p "Bind dired-x-find-file over find-file? ")))) - (define-key (current-global-map) [remap find-file] - (if (not dired-x-hands-off-my-keys) 'dired-x-find-file)) - (define-key (current-global-map) [remap find-file-other-window] - (if (not dired-x-hands-off-my-keys) 'dired-x-find-file-other-window))) + (unless dired-x-hands-off-my-keys + (define-key (current-global-map) [remap find-file] + 'dired-x-find-file) + (define-key (current-global-map) [remap find-file-other-window] + 'dired-x-find-file-other-window))) ;; Now call it so binding is correct. This could go in the :initialize ;; slot, but then dired-x-bind-find-file has to be defined before the diff --git a/lisp/dired.el b/lisp/dired.el index 9d500a9f52d..a056ad679fa 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -920,11 +920,12 @@ periodically reverts at specified time intervals." "Directory has changed on disk; type \\[revert-buffer] to update Dired"))))) ;; Else a new buffer (setq default-directory - ;; We can do this unconditionally - ;; because dired-noselect ensures that the name - ;; is passed in directory name syntax - ;; if it was the name of a directory at all. - (file-name-directory dirname)) + (or (car-safe (insert-directory-wildcard-in-dir-p dirname)) + ;; We can do this unconditionally + ;; because dired-noselect ensures that the name + ;; is passed in directory name syntax + ;; if it was the name of a directory at all. + (file-name-directory dirname))) (or switches (setq switches dired-listing-switches)) (if mode (funcall mode) (dired-mode dir-or-list switches)) @@ -1056,13 +1057,14 @@ wildcards, erases the buffer, and builds the subdir-alist anew (not file-list)) ;; If we are reading a whole single directory... (dired-insert-directory dir dired-actual-switches nil nil t) - (if (not (file-readable-p - (directory-file-name (file-name-directory dir)))) - (error "Directory %s inaccessible or nonexistent" dir) - ;; Else treat it as a wildcard spec - ;; unless we have an explicit list of files. - (dired-insert-directory dir dired-actual-switches - file-list (not file-list) t))))) + (if (and (not (insert-directory-wildcard-in-dir-p dir)) + (not (file-readable-p + (directory-file-name (file-name-directory dir))))) + (error "Directory %s inaccessible or nonexistent" dir)) + ;; Else treat it as a wildcard spec + ;; unless we have an explicit list of files. + (dired-insert-directory dir dired-actual-switches + file-list (not file-list) t)))) (defun dired-align-file (beg end) "Align the fields of a file to the ones of surrounding lines. @@ -1207,29 +1209,46 @@ If HDR is non-nil, insert a header line with the directory name." ;; as indicated by `ls-lisp-use-insert-directory-program'. (not (and (featurep 'ls-lisp) (null ls-lisp-use-insert-directory-program))) - (or (if (eq dired-use-ls-dired 'unspecified) + (not (and (featurep 'eshell) + (bound-and-true-p eshell-ls-use-in-dired))) + (or (file-remote-p dir) + (if (eq dired-use-ls-dired 'unspecified) ;; Check whether "ls --dired" gives exit code 0, and ;; save the answer in `dired-use-ls-dired'. (or (setq dired-use-ls-dired (eq 0 (call-process insert-directory-program - nil nil nil "--dired"))) + nil nil nil "--dired"))) (progn (message "ls does not support --dired; \ see `dired-use-ls-dired' for more details.") nil)) - dired-use-ls-dired) - (file-remote-p dir))) + dired-use-ls-dired))) (setq switches (concat "--dired " switches))) - ;; We used to specify the C locale here, to force English month names; - ;; but this should not be necessary any more, - ;; with the new value of `directory-listing-before-filename-regexp'. - (if file-list - (dolist (f file-list) - (let ((beg (point))) - (insert-directory f switches nil nil) - ;; Re-align fields, if necessary. - (dired-align-file beg (point)))) - (insert-directory dir switches wildcard (not wildcard))) + ;; Expand directory wildcards and fill file-list. + (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir))) + (cond (dir-wildcard + (setq switches (concat "-d " switches)) + (let ((default-directory (car dir-wildcard)) + (script (format "ls %s %s" switches (cdr dir-wildcard)))) + (unless + (zerop + (process-file + "/bin/sh" nil (current-buffer) nil "-c" script)) + (user-error + "%s: No files matching wildcard" (cdr dir-wildcard))) + (insert-directory-clean (point) switches))) + (t + ;; We used to specify the C locale here, to force English + ;; month names; but this should not be necessary any + ;; more, with the new value of + ;; `directory-listing-before-filename-regexp'. + (if file-list + (dolist (f file-list) + (let ((beg (point))) + (insert-directory f switches nil nil) + ;; Re-align fields, if necessary. + (dired-align-file beg (point)))) + (insert-directory dir switches wildcard (not wildcard)))))) ;; Quote certain characters, unless ls quoted them for us. (if (not (dired-switches-escape-p dired-actual-switches)) (save-excursion @@ -1279,11 +1298,14 @@ see `dired-use-ls-dired' for more details.") ;; Note that dired-build-subdir-alist will replace the name ;; by its expansion, so it does not matter whether what we insert ;; here is fully expanded, but it should be absolute. - (insert " " (directory-file-name (file-name-directory dir)) ":\n") + (insert " " (or (car-safe (insert-directory-wildcard-in-dir-p dir)) + (directory-file-name (file-name-directory dir))) ":\n") (setq content-point (point))) (when wildcard ;; Insert "wildcard" line where "total" line would be for a full dir. - (insert " wildcard " (file-name-nondirectory dir) "\n"))) + (insert " wildcard " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir)) + (file-name-nondirectory dir)) + "\n"))) (dired-insert-set-properties content-point (point))))) (defun dired-insert-set-properties (beg end) diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el new file mode 100644 index 00000000000..a99474547bf --- /dev/null +++ b/lisp/display-line-numbers.el @@ -0,0 +1,106 @@ +;;; display-line-numbers.el --- interface for display-line-numbers -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org +;; Keywords: convenience + +;; 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: + +;; Provides a minor mode interface for `display-line-numbers'. +;; +;; Toggle display of line numbers with M-x display-line-numbers-mode. +;; To enable line numbering in all buffers, use M-x +;; global-display-line-numbers-mode. To change the default type of +;; line numbers displayed, customize display-line-numbers-type. + +;; NOTE: Customization variables for `display-line-numbers' itself are +;; defined in cus-start.el. + +;;; Code: + +(defgroup display-line-numbers nil + "Display line numbers in the buffer." + :group 'display) + +;;;###autoload +(defcustom display-line-numbers-type t + "The default type of line numbers to use in `display-line-numbers-mode'. +See `display-line-numbers' for value options." + :group 'display-line-numbers + :type '(choice (const :tag "Relative line numbers" relative) + (const :tag "Relative visual line numbers" visual) + (other :tag "Absolute line numbers" t)) + :version "26.1") + +(defcustom display-line-numbers-grow-only nil + "If non-nil, do not shrink line number width." + :group 'display-line-numbers + :type 'boolean + :version "26.1") + +(defcustom display-line-numbers-width-start nil + "If non-nil, count number of lines to use for line number width. +When `display-line-numbers-mode' is turned on, +`display-line-numbers-width' is set to the minimum width necessary +to display all line numbers in the buffer." + :group 'display-line-numbers + :type 'boolean + :version "26.1") + +(defun display-line-numbers-update-width () + "Prevent the line number width from shrinking." + (let ((width (line-number-display-width))) + (when (> width (or display-line-numbers-width 1)) + (setq display-line-numbers-width width)))) + +;;;###autoload +(define-minor-mode display-line-numbers-mode + "Toggle display of line numbers in the buffer. +This uses `display-line-numbers' internally. + +To change the type of line numbers displayed by default, +customize `display-line-numbers-type'. To change the type while +the mode is on, set `display-line-numbers' directly." + :lighter nil + (if display-line-numbers-mode + (progn + (when display-line-numbers-width-start + (setq display-line-numbers-width + (length (number-to-string + (count-lines (point-min) (point-max)))))) + (when display-line-numbers-grow-only + (add-hook 'pre-command-hook #'display-line-numbers-update-width nil t)) + (setq display-line-numbers display-line-numbers-type)) + (remove-hook 'pre-command-hook #'display-line-numbers-update-width t) + (setq display-line-numbers nil))) + +(defun display-line-numbers--turn-on () + "Turn on `display-line-numbers-mode'." + (unless (or (minibufferp) + ;; taken from linum.el + (and (daemonp) (null (frame-parameter nil 'client)))) + (display-line-numbers-mode))) + +;;;###autoload +(define-globalized-minor-mode global-display-line-numbers-mode + display-line-numbers-mode display-line-numbers--turn-on) + +(provide 'display-line-numbers) + +;;; display-line-numbers.el ends here diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index c64376b940f..1a3f8e1f4d5 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -166,6 +166,10 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG (defmacro cl--generic (name) `(get ,name 'cl--generic)) +(defun cl-generic-p (f) + "Return non-nil if F is a generic function." + (and (symbolp f) (cl--generic f))) + (defun cl-generic-ensure-function (name &optional noerror) (let (generic (origname name)) @@ -182,8 +186,7 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG origname)) (if generic (cl-assert (eq name (cl--generic-name generic))) - (setf (cl--generic name) (setq generic (cl--generic-make name))) - (defalias name (cl--generic-make-function generic))) + (setf (cl--generic name) (setq generic (cl--generic-make name)))) generic)) ;;;###autoload @@ -410,7 +413,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined \(and can be extended) by the various methods of `cl-generic-generalizers'. \(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" - (declare (doc-string 3) (indent 2) + (declare (doc-string 3) (indent defun) (debug (&define ; this means we are defining something [&or name ("setf" name :name setf)] @@ -501,25 +504,26 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (cons method mt) ;; Keep the ordering; important for methods with :extra qualifiers. (mapcar (lambda (x) (if (eq x (car me)) method x)) mt))) - (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format - (cl--generic-name generic) - qualifiers specializers)) - current-load-list :test #'equal) - ;; FIXME: Try to avoid re-constructing a new function if the old one - ;; is still valid (e.g. still empty method cache)? - (let ((gfun (cl--generic-make-function generic)) - ;; Prevent `defalias' from recording this as the definition site of - ;; the generic function. - current-load-list) - ;; For aliases, cl--generic-name gives us the actual name. - (let ((purify-flag - ;; BEWARE! Don't purify this function definition, since that leads - ;; to memory corruption if the hash-tables it holds are modified - ;; (the GC doesn't trace those pointers). - nil)) + (let ((sym (cl--generic-name generic))) ; Actual name (for aliases). + (unless (symbol-function sym) + (defalias sym 'dummy)) ;Record definition into load-history. + (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format + (cl--generic-name generic) + qualifiers specializers)) + current-load-list :test #'equal) + ;; FIXME: Try to avoid re-constructing a new function if the old one + ;; is still valid (e.g. still empty method cache)? + (let ((gfun (cl--generic-make-function generic)) + ;; Prevent `defalias' from recording this as the definition site of + ;; the generic function. + current-load-list + ;; BEWARE! Don't purify this function definition, since that leads + ;; to memory corruption if the hash-tables it holds are modified + ;; (the GC doesn't trace those pointers). + (purify-flag nil)) ;; But do use `defalias', so that it interacts properly with nadvice, ;; e.g. for tracing/debug-on-entry. - (defalias (cl--generic-name generic) gfun))))) + (defalias sym gfun))))) (defmacro cl--generic-with-memoization (place &rest code) (declare (indent 1) (debug t)) @@ -1023,6 +1027,20 @@ The value returned is a list of elements of the form (push (cl--generic-method-info method) docs)))) docs)) +(defun cl--generic-method-files (method) + "Return a list of files where METHOD is defined by `cl-defmethod'. +The list will have entries of the form (FILE . (METHOD ...)) +where (METHOD ...) contains the qualifiers and specializers of +the method and is a suitable argument for +`find-function-search-for-symbol'. Filenames are absolute." + (let (result) + (pcase-dolist (`(,file . ,defs) load-history) + (dolist (def defs) + (when (and (eq (car-safe def) 'cl-defmethod) + (eq (cadr def) method)) + (push (cons file (cdr def)) result)))) + result)) + ;;; Support for (head <val>) specializers. ;; For both the `eql' and the `head' specializers, the dispatch @@ -1210,5 +1228,18 @@ Used internally for the (major-mode MODE) context specializers." (progn (cl-assert (null modes)) mode) `(derived-mode ,mode . ,modes)))) +;;; Support for unloading. + +(cl-defmethod loadhist-unload-element ((x (head cl-defmethod))) + (pcase-let* + ((`(,name ,qualifiers . ,specializers) (cdr x)) + (generic (cl-generic-ensure-function name 'noerror))) + (when generic + (let* ((mt (cl--generic-method-table generic)) + (me (cl--generic-member-method specializers qualifiers mt))) + (when me + (setf (cl--generic-method-table generic) (delq (car me) mt))))))) + + (provide 'cl-generic) ;;; cl-generic.el ends here diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1494ed1d9c3..c6ef8d7a99c 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3213,8 +3213,8 @@ instrument cannot be found, signal an error." ((consp func-marker) (message "%s is already instrumented." func) (list func)) - ((get func 'cl--generic) - (let ((method-defs (method-files func)) + ((cl-generic-p func) + (let ((method-defs (cl--generic-method-files func)) symbols) (unless method-defs (error "Could not find any method definitions for %s" func)) diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index e6e6d118709..8403a8a655f 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -165,7 +165,8 @@ Summary: (if (memq method '(no-next-method no-applicable-method)) (symbol-function method) (let ((generic (cl-generic-ensure-function method))) - (symbol-function (cl--generic-name generic))))) + (or (symbol-function (cl--generic-name generic)) + (cl--generic-make-function generic))))) ;;;###autoload (defun eieio--defmethod (method kind argclass code) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index a05bd7cc4d4..bca40ab87da 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -160,6 +160,10 @@ This is used to determine if `eldoc-idle-delay' is changed by the user.") It should receive the same arguments as `message'.") (defun eldoc-edit-message-commands () + "Return an obarray containing common editing commands. + +When `eldoc-print-after-edit' is non-nil, ElDoc messages are only +printed after commands contained in this obarray." (let ((cmds (make-vector 31 0)) (re (regexp-opt '("delete" "insert" "edit" "electric" "newline")))) (mapatoms (lambda (s) @@ -211,16 +215,21 @@ expression point is on." ;;;###autoload (defun turn-on-eldoc-mode () - "Turn on `eldoc-mode' if the buffer has eldoc support enabled. + "Turn on `eldoc-mode' if the buffer has ElDoc support enabled. See `eldoc-documentation-function' for more detail." (when (eldoc--supported-p) (eldoc-mode 1))) (defun eldoc--supported-p () + "Non-nil if an ElDoc function is set for this buffer." (not (memq eldoc-documentation-function '(nil ignore)))) (defun eldoc-schedule-timer () + "Ensure `eldoc-timer' is running. + +If the user has changed `eldoc-idle-delay', update the timer to +reflect the change." (or (and eldoc-timer (memq eldoc-timer timer-idle-list)) ;FIXME: Why? (setq eldoc-timer @@ -229,8 +238,7 @@ See `eldoc-documentation-function' for more detail." (lambda () (when (or eldoc-mode (and global-eldoc-mode - (not (memq eldoc-documentation-function - '(nil ignore))))) + (eldoc--supported-p))) (eldoc-print-current-symbol-info)))))) ;; If user has changed the idle delay, update the timer. @@ -268,16 +276,19 @@ Otherwise work like `message'." (force-mode-line-update))) (apply 'message format-string args))) -(defun eldoc-message (&rest args) +(defun eldoc-message (&optional format-string &rest args) + "Display FORMAT-STRING formatted with ARGS as an ElDoc message. + +Store the message (if any) in `eldoc-last-message', and return it." (let ((omessage eldoc-last-message)) (setq eldoc-last-message - (cond ((eq (car args) eldoc-last-message) eldoc-last-message) - ((null (car args)) nil) + (cond ((eq format-string eldoc-last-message) eldoc-last-message) + ((null format-string) nil) ;; If only one arg, no formatting to do, so put it in ;; eldoc-last-message so eq test above might succeed on ;; subsequent calls. - ((null (cdr args)) (car args)) - (t (apply #'format-message args)))) + ((null args) format-string) + (t (apply #'format-message format-string args)))) ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages ;; are recorded in a log. Do not put eldoc messages in that log since ;; they are Legion. @@ -289,6 +300,7 @@ Otherwise work like `message'." eldoc-last-message) (defun eldoc--message-command-p (command) + "Return non-nil if COMMAND is in `eldoc-message-commands'." (and (symbolp command) (intern-soft (symbol-name command) eldoc-message-commands))) @@ -299,6 +311,7 @@ Otherwise work like `message'." ;; before the next command executes, which does away with the flicker. ;; This doesn't seem to be required for Emacs 19.28 and earlier. (defun eldoc-pre-command-refresh-echo-area () + "Reprint `eldoc-last-message' in the echo area." (and eldoc-last-message (not (minibufferp)) ;We don't use the echo area when in minibuffer. (if (and (eldoc-display-message-no-interference-p) @@ -310,6 +323,7 @@ Otherwise work like `message'." ;; Decide whether now is a good time to display a message. (defun eldoc-display-message-p () + "Return non-nil when it is appropriate to display an ElDoc message." (and (eldoc-display-message-no-interference-p) ;; If this-command is non-nil while running via an idle ;; timer, we're still in the middle of executing a command, @@ -322,6 +336,7 @@ Otherwise work like `message'." ;; Check various conditions about the current environment that might make ;; it undesirable to print eldoc messages right this instant. (defun eldoc-display-message-no-interference-p () + "Return nil if displaying a message would cause interference." (not (or executing-kbd-macro (bound-and-true-p edebug-active)))) @@ -347,6 +362,7 @@ variable) is taken into account if the major mode specific function does not return any documentation.") (defun eldoc-print-current-symbol-info () + "Print the text produced by `eldoc-documentation-function'." ;; This is run from post-command-hook or some idle timer thing, ;; so we need to be careful that errors aren't ignored. (with-demoted-errors "eldoc error: %s" @@ -361,6 +377,13 @@ return any documentation.") ;; truncated or eliminated entirely from the output to make room for the ;; description. (defun eldoc-docstring-format-sym-doc (prefix doc &optional face) + "Combine PREFIX and DOC, and shorten the result to fit in the echo area. + +When PREFIX is a symbol, propertize its symbol name with FACE +before combining it with DOC. If FACE is not provided, just +apply the nil face. + +See also: `eldoc-echo-area-use-multiline-p'." (when (symbolp prefix) (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": "))) (let* ((ea-multi eldoc-echo-area-use-multiline-p) @@ -390,22 +413,26 @@ return any documentation.") ;; These functions do display-command table management. (defun eldoc-add-command (&rest cmds) + "Add each of CMDS to the obarray `eldoc-message-commands'." (dolist (name cmds) (and (symbolp name) (setq name (symbol-name name))) (set (intern name eldoc-message-commands) t))) (defun eldoc-add-command-completions (&rest names) + "Pass every prefix completion of NAMES to `eldoc-add-command'." (dolist (name names) (apply #'eldoc-add-command (all-completions name obarray 'commandp)))) (defun eldoc-remove-command (&rest cmds) + "Remove each of CMDS from the obarray `eldoc-message-commands'." (dolist (name cmds) (and (symbolp name) (setq name (symbol-name name))) (unintern name eldoc-message-commands))) (defun eldoc-remove-command-completions (&rest names) + "Pass every prefix completion of NAMES to `eldoc-remove-command'." (dolist (name names) (apply #'eldoc-remove-command (all-completions name eldoc-message-commands)))) @@ -418,9 +445,9 @@ return any documentation.") "down-list" "end-of-" "exchange-point-and-mark" "forward-" "goto-" "handle-select-window" "indent-for-tab-command" "left-" "mark-page" "mark-paragraph" "mouse-set-point" "move-" "move-beginning-of-" - "move-end-of-" "newline" "next-" "other-window" "pop-global-mark" "previous-" - "recenter" "right-" "scroll-" "self-insert-command" "split-window-" - "up-list") + "move-end-of-" "newline" "next-" "other-window" "pop-global-mark" + "previous-" "recenter" "right-" "scroll-" "self-insert-command" + "split-window-" "up-list") (provide 'eldoc) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index d4500f131a2..7bdd749d5ab 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -583,6 +583,11 @@ displayed." (elp-restore-all) ;; continue standard unloading nil) + +(cl-defmethod loadhist-unload-element :before :extra "elp" ((x (head defun))) + "Un-instrument before unloading a function." + (elp-restore-function (cdr x))) + (provide 'elp) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index cee225cc8e0..d7bd331c11b 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -135,7 +135,7 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." ;; Note that nil is still a valid value for the `name' slot in ;; ert-test objects. It designates an anonymous test. (error "Attempt to define a test named nil")) - (put symbol 'ert--test definition) + (define-symbol-prop symbol 'ert--test definition) definition) (defun ert-make-test-unbound (symbol) @@ -214,12 +214,6 @@ description of valid values for RESULT-TYPE. ,@(when tags-supplied-p `(:tags ,tags)) :body (lambda () ,@body))) - ;; This hack allows `symbol-file' to associate `ert-deftest' - ;; forms with files, and therefore enables `find-function' to - ;; work with tests. However, it leads to warnings in - ;; `unload-feature', which doesn't know how to undefine tests - ;; and has no mechanism for extension. - (push '(ert-deftest . ,name) current-load-list) ',name)))) ;; We use these `put' forms in addition to the (declare (indent)) in @@ -2405,8 +2399,7 @@ To be used in the ERT results buffer." (buffer-disable-undo) (erase-buffer) (ert-simple-view-mode) - ;; Use unibyte because `debugger-setup-buffer' also does so. - (set-buffer-multibyte nil) + (set-buffer-multibyte t) ; mimic debugger-setup-buffer (setq truncate-lines t) (ert--print-backtrace backtrace t) (goto-char (point-min)) @@ -2539,7 +2532,7 @@ To be used in the ERT results buffer." (insert (if test-name (format "%S" test-name) "<anonymous test>")) (insert " is a test") (let ((file-name (and test-name - (symbol-file test-name 'ert-deftest)))) + (symbol-file test-name 'ert--test)))) (when file-name (insert (format-message " defined in `%s'" (file-name-nondirectory file-name))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 4a06ab25d3e..253b60e7534 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -418,8 +418,8 @@ to this macro." (when decl (setq body (remove decl body))) `(progn (defun ,fsym ,args ,@body) - (put ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl))) - (put ',name 'pcase-macroexpander #',fsym)))) + (define-symbol-prop ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl))) + (define-symbol-prop ',name 'pcase-macroexpander #',fsym)))) (defun pcase--match (val upat) "Build a MATCH structure, hoisting all `or's and `and's outside." @@ -930,6 +930,5 @@ QPAT can take the following forms: ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat) (t (error "Unknown QPAT: %S" qpat)))) - (provide 'pcase) ;;; pcase.el ends here diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 386232c6eef..b66f2c6d512 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1169,6 +1169,62 @@ enclosed in `(and ...)'. (rx-to-string `(and ,@regexps) t)) (t (rx-to-string (car regexps) t)))) + + +(pcase-defmacro rx (&rest regexps) + "Build a `pcase' pattern matching `rx' regexps. +The REGEXPS are interpreted as by `rx'. The pattern matches if +the regular expression so constructed matches the object, as if +by `string-match'. + +In addition to the usual `rx' constructs, REGEXPS can contain the +following constructs: + + (let VAR FORM...) creates a new explicitly numbered submatch + that matches FORM and binds the match to + VAR. + (backref VAR) creates a backreference to the submatch + introduced by a previous (let VAR ...) + construct. + +The VARs are associated with explicitly numbered submatches +starting from 1. Multiple occurrences of the same VAR refer to +the same submatch. + +If a case matches, the match data is modified as usual so you can +use it in the case body, but you still have to pass the correct +string as argument to `match-string'." + (let* ((vars ()) + (rx-constituents + `((let + ,(lambda (form) + (rx-check form) + (let ((var (cadr form))) + (cl-check-type var symbol) + (let ((i (or (cl-position var vars :test #'eq) + (prog1 (length vars) + (setq vars `(,@vars ,var)))))) + (rx-form `(submatch-n ,(1+ i) ,@(cddr form)))))) + 1 nil) + (backref + ,(lambda (form) + (rx-check form) + (rx-backref + `(backref ,(let ((var (cadr form))) + (if (integerp var) var + (1+ (cl-position var vars :test #'eq))))))) + 1 1 + ,(lambda (var) + (cond ((integerp var) (rx-check-backref var)) + ((memq var vars) t) + (t (error "rx `backref' variable must be one of %s: %s" + vars var))))) + ,@rx-constituents)) + (regexp (rx-to-string `(seq ,@regexps) :no-group))) + `(and (pred (string-match ,regexp)) + ,@(cl-loop for i from 1 + for var in vars + collect `(app (match-string ,i) ,var))))) ;; ;; sregex.el replacement diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 79799db30bc..4a5adc48f2b 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -65,17 +65,19 @@ This is useful for enabling human-readable format (-h), for example." "If non-nil, use `eshell-ls' to read directories in Dired. Changing this without using customize has no effect." :set (lambda (symbol value) - (if value - (advice-add 'insert-directory :around - #'eshell-ls--insert-directory) - (advice-remove 'insert-directory - #'eshell-ls--insert-directory)) + (cond (value + (require 'dired) + (advice-add 'insert-directory :around + #'eshell-ls--insert-directory) + (advice-add 'dired :around #'eshell-ls--dired)) + (t + (advice-remove 'insert-directory + #'eshell-ls--insert-directory) + (advice-remove 'dired #'eshell-ls--dired))) (set symbol value)) :type 'boolean :require 'em-ls) -(add-hook 'eshell-ls-unload-hook - (lambda () (advice-remove 'insert-directory - #'eshell-ls--insert-directory))) +(add-hook 'eshell-ls-unload-hook #'eshell-ls-unload-function) (defcustom eshell-ls-default-blocksize 1024 @@ -279,6 +281,36 @@ instead." eshell-ls-dired-initial-args) (eshell-do-ls (append switches (list file))))))))) +(declare-function eshell-extended-glob "em-glob" (glob)) +(declare-function dired-read-dir-and-switches "dired" (str)) +(declare-function dired-goto-next-file "dired" ()) + +(defun eshell-ls--dired (orig-fun dir-or-list &optional switches) + (interactive (dired-read-dir-and-switches "")) + (require 'em-glob) + (if (consp dir-or-list) + (funcall orig-fun dir-or-list switches) + (let ((dir-wildcard (insert-directory-wildcard-in-dir-p + (expand-file-name dir-or-list)))) + (if (not dir-wildcard) + (funcall orig-fun dir-or-list switches) + (let* ((default-directory (car dir-wildcard)) + (files (eshell-extended-glob (cdr dir-wildcard))) + (dir (car dir-wildcard))) + (if files + (let ((inhibit-read-only t) + (buf + (apply orig-fun + (nconc (list dir) files) + (and switches (list switches))))) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (dired-goto-next-file) + (forward-line 0) + (insert " wildcard " (cdr dir-wildcard) "\n")))) + (user-error "No files matching regexp"))))))) + (defsubst eshell/ls (&rest args) "An alias version of `eshell-do-ls'." (let ((insert-func 'eshell-buffered-print) @@ -909,6 +941,11 @@ to use, and each member of which is the width of that column (car file))))) (car file)) +(defun eshell-ls-unload-function () + (advice-remove 'insert-directory #'eshell-ls--insert-directory) + (advice-remove 'dired #'eshell-ls--dired) + nil) + (provide 'em-ls) ;; Local Variables: diff --git a/lisp/faces.el b/lisp/faces.el index 97c32165b9c..c0c1c7b59f0 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -104,7 +104,9 @@ a font height that isn't optimal." ;; when combined with Monospaced and with other standard fonts. ;; One of its uses is for 'tex-verbatim' and 'Info-quoted' faces, ;; so the result must be different from the default face's font, - ;; and must be monospaced. + ;; and must be monospaced. For 'tex-verbatim', it is desirable + ;; that the font really is a Serif font, so as to look like + ;; TeX's 'verbatim'. ("Monospace Serif" ;; This looks good on GNU/Linux. diff --git a/lisp/files.el b/lisp/files.el index 2f3efa33c28..96647fb2626 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -978,12 +978,15 @@ or mount points potentially requiring authentication as a different user.") ;; nil))) (defun locate-dominating-file (file name) - "Look up the directory hierarchy from FILE for a directory containing NAME. + "Starting from FILE, look up directory hierarchy for directory containing NAME. +FILE can be a file or a directory. If it's a file, its directory will +serve as the starting point for searching the hierarchy of directories. Stop at the first parent directory containing a file NAME, and return the directory. Return nil if not found. Instead of a string, NAME can also be a predicate taking one argument \(a directory) and returning a non-nil value if that directory is the one for -which we're looking." +which we're looking. The predicate will be called with every file/directory +the function needs to examine, starting with FILE." ;; We used to use the above locate-dominating-files code, but the ;; directory-files call is very costly, so we're much better off doing ;; multiple calls using the code in here. @@ -1596,8 +1599,8 @@ automatically choosing a major mode, use \\[find-file-literally]." (confirm-nonexistent-file-or-buffer))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) - (mapcar 'switch-to-buffer (nreverse value)) - (switch-to-buffer value)))) + (mapcar 'pop-to-buffer-same-window (nreverse value)) + (pop-to-buffer-same-window value)))) (defun find-file-other-window (filename &optional wildcards) "Edit file FILENAME, in another window. @@ -2543,7 +2546,7 @@ since only a single case-insensitive search through the alist is made." ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) ("\\.bash\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode) - ("\\(/\\|\\`\\)\\.\\(shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) + ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) ("\\.m?spec\\'" . sh-mode) ("\\.m[mes]\\'" . nroff-mode) @@ -6552,6 +6555,75 @@ regardless of the language.") (defvar insert-directory-ls-version 'unknown) +(defun insert-directory-wildcard-in-dir-p (dir) + "Return non-nil if DIR contents a shell wildcard in the directory part. +The return value is a cons (DIR . WILDCARDS); DIR is the +`default-directory' in the Dired buffer, and WILDCARDS are the wildcards. + +Valid wildcards are '*', '?', '[abc]' and '[a-z]'." + (let ((wildcards "[?*")) + (when (and (or (not (featurep 'ls-lisp)) + ls-lisp-support-shell-wildcards) + (string-match (concat "[" wildcards "]") (file-name-directory dir)) + (not (file-exists-p dir))) ; Prefer an existing file to wildcards. + (let ((regexp (format "\\`\\([^%s]+/\\)\\([^%s]*[%s].*\\)" + wildcards wildcards wildcards))) + (string-match regexp dir) + (cons (match-string 1 dir) (match-string 2 dir)))))) + +(defun insert-directory-clean (beg switches) + (when (if (stringp switches) + (string-match "--dired\\>" switches) + (member "--dired" switches)) + ;; The following overshoots by one line for an empty + ;; directory listed with "--dired", but without "-a" + ;; switch, where the ls output contains a + ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line. + ;; We take care of that case later. + (forward-line -2) + (when (looking-at "//SUBDIRED//") + (delete-region (point) (progn (forward-line 1) (point))) + (forward-line -1)) + (if (looking-at "//DIRED//") + (let ((end (line-end-position)) + (linebeg (point)) + error-lines) + ;; Find all the lines that are error messages, + ;; and record the bounds of each one. + (goto-char beg) + (while (< (point) linebeg) + (or (eql (following-char) ?\s) + (push (list (point) (line-end-position)) error-lines)) + (forward-line 1)) + (setq error-lines (nreverse error-lines)) + ;; Now read the numeric positions of file names. + (goto-char linebeg) + (forward-word-strictly 1) + (forward-char 3) + (while (< (point) end) + (let ((start (insert-directory-adj-pos + (+ beg (read (current-buffer))) + error-lines)) + (end (insert-directory-adj-pos + (+ beg (read (current-buffer))) + error-lines))) + (if (memq (char-after end) '(?\n ?\s)) + ;; End is followed by \n or by " -> ". + (put-text-property start end 'dired-filename t) + ;; It seems that we can't trust ls's output as to + ;; byte positions of filenames. + (put-text-property beg (point) 'dired-filename nil) + (end-of-line)))) + (goto-char end) + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point)))) + ;; Take care of the case where the ls output contains a + ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line + ;; and we went one line too far back (see above). + (forward-line 1)) + (if (looking-at "//DIRED-OPTIONS//") + (delete-region (point) (progn (forward-line 1) (point)))))) + ;; insert-directory ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and ;; FULL-DIRECTORY-P is nil. @@ -6611,13 +6683,19 @@ normally equivalent short `-D' option is just passed on to default-file-name-coding-system)))) (setq result (if wildcard - ;; Run ls in the directory part of the file pattern - ;; using the last component as argument. - (let ((default-directory - (if (file-name-absolute-p file) - (file-name-directory file) - (file-name-directory (expand-file-name file)))) - (pattern (file-name-nondirectory file))) + ;; If the wildcard is just in the file part, then run ls in + ;; the directory part of the file pattern using the last + ;; component as argument. Otherwise, run ls in the longest + ;; subdirectory of the directory part free of wildcards; use + ;; the remaining of the file pattern as argument. + (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file)) + (default-directory + (cond (dir-wildcard (car dir-wildcard)) + (t + (if (file-name-absolute-p file) + (file-name-directory file) + (file-name-directory (expand-file-name file)))))) + (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file)))) ;; NB since switches is passed to the shell, be ;; careful of malicious values, eg "-l;reboot". ;; See eg dired-safe-switches-p. @@ -6665,7 +6743,8 @@ normally equivalent short `-D' option is just passed on to (setq file (expand-file-name file))) (list (if full-directory-p - (concat (file-name-as-directory file) ".") + ;; (concat (file-name-as-directory file) ".") + file file)))))))) ;; If we got "//DIRED//" in the output, it means we got a real @@ -6736,59 +6815,7 @@ normally equivalent short `-D' option is just passed on to ;; Unix. Access the file to get a suitable error. (access-file file "Reading directory") (error "Listing directory failed but `access-file' worked"))) - - (when (if (stringp switches) - (string-match "--dired\\>" switches) - (member "--dired" switches)) - ;; The following overshoots by one line for an empty - ;; directory listed with "--dired", but without "-a" - ;; switch, where the ls output contains a - ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line. - ;; We take care of that case later. - (forward-line -2) - (when (looking-at "//SUBDIRED//") - (delete-region (point) (progn (forward-line 1) (point))) - (forward-line -1)) - (if (looking-at "//DIRED//") - (let ((end (line-end-position)) - (linebeg (point)) - error-lines) - ;; Find all the lines that are error messages, - ;; and record the bounds of each one. - (goto-char beg) - (while (< (point) linebeg) - (or (eql (following-char) ?\s) - (push (list (point) (line-end-position)) error-lines)) - (forward-line 1)) - (setq error-lines (nreverse error-lines)) - ;; Now read the numeric positions of file names. - (goto-char linebeg) - (forward-word-strictly 1) - (forward-char 3) - (while (< (point) end) - (let ((start (insert-directory-adj-pos - (+ beg (read (current-buffer))) - error-lines)) - (end (insert-directory-adj-pos - (+ beg (read (current-buffer))) - error-lines))) - (if (memq (char-after end) '(?\n ?\s)) - ;; End is followed by \n or by " -> ". - (put-text-property start end 'dired-filename t) - ;; It seems that we can't trust ls's output as to - ;; byte positions of filenames. - (put-text-property beg (point) 'dired-filename nil) - (end-of-line)))) - (goto-char end) - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Take care of the case where the ls output contains a - ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line - ;; and we went one line too far back (see above). - (forward-line 1)) - (if (looking-at "//DIRED-OPTIONS//") - (delete-region (point) (progn (forward-line 1) (point))))) - + (insert-directory-clean beg switches) ;; Now decode what read if necessary. (let ((coding (or coding-system-for-read file-name-coding-system diff --git a/lisp/find-dired.el b/lisp/find-dired.el index a92d477e1e0..2292b5f32d4 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -1,4 +1,4 @@ -;;; find-dired.el --- run a `find' command and dired the output +;;; find-dired.el --- run a `find' command and dired the output -*- lexical-binding: t -*- ;; Copyright (C) 1992, 1994-1995, 2000-2017 Free Software Foundation, ;; Inc. diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index e9f844487bc..a795211f4fe 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -1,4 +1,4 @@ -;;; find-lisp.el --- emulation of find in Emacs Lisp +;;; find-lisp.el --- emulation of find in Emacs Lisp -*- lexical-binding: t -*- ;; Author: Peter Breton ;; Created: Fri Mar 26 1999 diff --git a/lisp/frame.el b/lisp/frame.el index 99d9159be9e..67b6bb53d87 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2158,7 +2158,7 @@ To adjust bottom dividers for frames individually, use the frame parameter `bottom-divider-width'." :type '(restricted-sexp :tag "Default width of bottom dividers" - :match-alternatives (frame-window-divider-width-valid-p)) + :match-alternatives (window-divider-width-valid-p)) :initialize 'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) @@ -2175,7 +2175,7 @@ To adjust right dividers for frames individually, use the frame parameter `right-divider-width'." :type '(restricted-sexp :tag "Default width of right dividers" - :match-alternatives (frame-window-divider-width-valid-p)) + :match-alternatives (window-divider-width-valid-p)) :initialize 'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) diff --git a/lisp/ido.el b/lisp/ido.el index 07a5bcf7229..defb744201d 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1,4 +1,4 @@ -;;; ido.el --- interactively do things with buffers and files +;;; ido.el --- interactively do things with buffers and files -*- lexical-binding: t -*- ;; Copyright (C) 1996-2017 Free Software Foundation, Inc. diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 838a492b6cb..2db8061fa4a 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -1,4 +1,4 @@ -;;; kmacro.el --- enhanced keyboard macros +;;; kmacro.el --- enhanced keyboard macros -*- lexical-binding: t -*- ;; Copyright (C) 2002-2017 Free Software Foundation, Inc. @@ -565,7 +565,8 @@ Use \\[kmacro-insert-counter] to insert (and increment) the macro counter. The counter value can be set or modified via \\[kmacro-set-counter] and \\[kmacro-add-counter]. The format of the counter can be modified via \\[kmacro-set-format]. -Use \\[kmacro-name-last-macro] to give it a permanent name. +Use \\[kmacro-name-last-macro] to give it a name that will remain valid even +after another macro is defined. Use \\[kmacro-bind-to-key] to bind it to a key sequence." (interactive "P") (if (or defining-kbd-macro executing-kbd-macro) @@ -628,8 +629,8 @@ just the last key in the key sequence that you used to call this command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg' for details on how to adjust or disable this behavior. -To make a macro permanent so you can call it even after defining -others, use \\[kmacro-name-last-macro]." +To give a macro a name so you can call it even after defining others, +use \\[kmacro-name-last-macro]." (interactive "p") (let ((repeat-key (and (or (and (null no-repeat) (> (length (this-single-command-keys)) 1)) @@ -730,8 +731,8 @@ With \\[universal-argument], call second macro in macro ring." With numeric prefix ARG, repeat macro that many times. Zero argument means repeat until there is an error. -To give a macro a permanent name, so you can call it -even after defining other macros, use \\[kmacro-name-last-macro]." +To give a macro a name, so you can call it even after defining other +macros, use \\[kmacro-name-last-macro]." (interactive "P") (if defining-kbd-macro (kmacro-end-macro nil)) diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 28d0b18c812..18c30f781f0 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -162,6 +162,70 @@ documentation of `unload-feature' for details.") ;; mode, or proposed is not nil and not major-mode, and so we use it. (funcall (or proposed 'fundamental-mode))))))) +(cl-defgeneric loadhist-unload-element (x) + "Unload an element from the `load-history'." + (message "Unexpected element %S in load-history" x)) + +;; In `load-history', the definition of a previously autoloaded +;; function is represented by 2 entries: (t . SYMBOL) comes before +;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when +;; we undefine it. +;; So we use this auxiliary variable to keep track of the last (t . SYMBOL) +;; that occurred. +(defvar loadhist--restore-autoload + "If non-nil, this is a symbol for which we should +restore a previous autoload if possible.") + +(cl-defmethod loadhist-unload-element ((x (head t))) + (setq loadhist--restore-autoload (cdr x))) + +(defun loadhist--unload-function (x) + (let ((fun (cdr x))) + (when (fboundp fun) + (when (fboundp 'ad-unadvise) + (ad-unadvise fun)) + (let ((aload (get fun 'autoload))) + (defalias fun + (if (and aload (eq fun loadhist--restore-autoload)) + (cons 'autoload aload) + nil))))) + (setq loadhist--restore-autoload nil)) + +(cl-defmethod loadhist-unload-element ((x (head defun))) + (loadhist--unload-function x)) +(cl-defmethod loadhist-unload-element ((x (head autoload))) + (loadhist--unload-function x)) + +(cl-defmethod loadhist-unload-element ((_ (head require))) nil) +(cl-defmethod loadhist-unload-element ((_ (head defface))) nil) + +(cl-defmethod loadhist-unload-element ((x (head provide))) + ;; Remove any feature names that this file provided. + (setq features (delq (cdr x) features))) + +(cl-defmethod loadhist-unload-element ((x symbol)) + ;; Kill local values as much as possible. + (dolist (buf (buffer-list)) + (with-current-buffer buf + (if (and (boundp x) (timerp (symbol-value x))) + (cancel-timer (symbol-value x))) + (kill-local-variable x))) + (if (and (boundp x) (timerp (symbol-value x))) + (cancel-timer (symbol-value x))) + ;; Get rid of the default binding if we can. + (unless (local-variable-if-set-p x) + (makunbound x))) + +(cl-defmethod loadhist-unload-element ((x (head define-type))) + (let* ((name (cdr x))) + ;; Remove the struct. + (setf (cl--find-class name) nil))) + +(cl-defmethod loadhist-unload-element ((x (head define-symbol-props))) + (pcase-dolist (`(,symbol . ,props) (cdr x)) + (dolist (prop props) + (put symbol prop nil)))) + ;;;###autoload (defun unload-feature (feature &optional force) "Unload the library that provided FEATURE. @@ -200,9 +264,6 @@ something strange, such as redefining an Emacs function." (prin1-to-string dependents) file)))) (let* ((unload-function-defs-list (feature-symbols feature)) (file (pop unload-function-defs-list)) - ;; If non-nil, this is a symbol for which we should - ;; restore a previous autoload if possible. - restore-autoload (name (symbol-name feature)) (unload-hook (intern-soft (concat name "-unload-hook"))) (unload-func (intern-soft (concat name "-unload-function")))) @@ -245,43 +306,7 @@ something strange, such as redefining an Emacs function." ;; Change major mode in all buffers using one defined in the feature being unloaded. (unload--set-major-mode) - (when (fboundp 'elp-restore-function) ; remove ELP stuff first - (dolist (elt unload-function-defs-list) - (when (symbolp elt) - (elp-restore-function elt)))) - - (dolist (x unload-function-defs-list) - (if (consp x) - (pcase (car x) - ;; Remove any feature names that this file provided. - (`provide - (setq features (delq (cdr x) features))) - ((or `defun `autoload) - (let ((fun (cdr x))) - (when (fboundp fun) - (when (fboundp 'ad-unadvise) - (ad-unadvise fun)) - (let ((aload (get fun 'autoload))) - (if (and aload (eq fun restore-autoload)) - (fset fun (cons 'autoload aload)) - (fmakunbound fun)))))) - ;; (t . SYMBOL) comes before (defun . SYMBOL) - ;; and says we should restore SYMBOL's autoload - ;; when we undefine it. - (`t (setq restore-autoload (cdr x))) - ((or `require `defface) nil) - (_ (message "Unexpected element %s in load-history" x))) - ;; Kill local values as much as possible. - (dolist (buf (buffer-list)) - (with-current-buffer buf - (if (and (boundp x) (timerp (symbol-value x))) - (cancel-timer (symbol-value x))) - (kill-local-variable x))) - (if (and (boundp x) (timerp (symbol-value x))) - (cancel-timer (symbol-value x))) - ;; Get rid of the default binding if we can. - (unless (local-variable-if-set-p x) - (makunbound x)))) + (mapc #'loadhist-unload-element unload-function-defs-list) ;; Delete the load-history element for this file. (setq load-history (delq (assoc file load-history) load-history)))) ;; Don't return load-history, it is not useful. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index b368efbbc95..2f723ca8ac8 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -1,4 +1,4 @@ -;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp +;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp -*- lexical-binding: t -*- ;; Copyright (C) 1992, 1994, 2000-2017 Free Software Foundation, Inc. @@ -60,6 +60,8 @@ ;;; Code: + + (defgroup ls-lisp nil "Emulate the ls program completely in Emacs Lisp." :version "21.1" @@ -477,6 +479,37 @@ not contain `d', so that a full listing is expected." (message "%s: doesn't exist or is inaccessible" file) (ding) (sit-for 2))))) ; to show user the message! + +(declare-function eshell-extended-glob "em-glob" (glob)) +(declare-function dired-read-dir-and-switches "dired" (str)) +(declare-function dired-goto-next-file "dired" ()) + +(defun ls-lisp--dired (orig-fun dir-or-list &optional switches) + (interactive (dired-read-dir-and-switches "")) + (require 'em-glob) + (if (consp dir-or-list) + (funcall orig-fun dir-or-list switches) + (let ((dir-wildcard (insert-directory-wildcard-in-dir-p + (expand-file-name dir-or-list)))) + (if (not dir-wildcard) + (funcall orig-fun dir-or-list switches) + (let* ((default-directory (car dir-wildcard)) + (files (eshell-extended-glob (cdr dir-wildcard))) + (dir (car dir-wildcard))) + (if files + (let ((inhibit-read-only t) + (buf + (apply orig-fun (nconc (list dir) files) (and switches (list switches))))) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (dired-goto-next-file) + (forward-line 0) + (insert " wildcard " (cdr dir-wildcard) "\n")))) + (user-error "No files matching regexp"))))))) + +(advice-add 'dired :around #'ls-lisp--dired) + (defun ls-lisp-sanitize (file-alist) "Sanitize the elements in FILE-ALIST. Fixes any elements in the alist for directory entries whose file @@ -866,6 +899,13 @@ All ls time options, namely c, t and u, are handled." file-size) (format " %6s" (file-size-human-readable file-size)))) +(defun ls-lisp-unload-function () + "Unload ls-lisp library." + (advice-remove 'insert-directory #'ls-lisp--insert-directory) + (advice-remove 'dired #'ls-lisp--dired) + ;; Continue standard unloading. + nil) + (provide 'ls-lisp) ;;; ls-lisp.el ends here diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 4a569783293..05a336bfe28 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1101,23 +1101,68 @@ The selected font will be the default on both the existing and future frames." :button (:radio . (eq tool-bar-mode nil)))) menu))) -(defun toggle-display-line-numbers () - (interactive) - (if display-line-numbers - (setq display-line-numbers nil) - (setq display-line-numbers t)) - (force-mode-line-update)) +(defun menu-bar-display-line-numbers-mode (type) + (setq display-line-numbers-type type) + (if global-display-line-numbers-mode + (global-display-line-numbers-mode) + (display-line-numbers-mode))) + +(defvar menu-bar-showhide-line-numbers-menu + (let ((menu (make-sparse-keymap "Line Numbers"))) + + (bindings--define-key menu [visual] + `(menu-item "Visual Line Numbers" + ,(lambda () + (interactive) + (menu-bar-display-line-numbers-mode 'visual) + (message "Visual line numbers enabled")) + :help "Enable visual line numbers" + :button (:radio . (eq display-line-numbers 'visual)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (bindings--define-key menu [relative] + `(menu-item "Relative Line Numbers" + ,(lambda () + (interactive) + (menu-bar-display-line-numbers-mode 'relative) + (message "Relative line numbers enabled")) + :help "Enable relative line numbers" + :button (:radio . (eq display-line-numbers 'relative)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (bindings--define-key menu [absolute] + `(menu-item "Absolute Line Numbers" + ,(lambda () + (interactive) + (menu-bar-display-line-numbers-mode t) + (setq display-line-numbers t) + (message "Absolute line numbers enabled")) + :help "Enable absolute line numbers" + :button (:radio . (eq display-line-numbers t)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (bindings--define-key menu [none] + `(menu-item "No Line Numbers" + ,(lambda () + (interactive) + (menu-bar-display-line-numbers-mode nil) + (message "Line numbers disabled")) + :help "Disable line numbers" + :button (:radio . (null display-line-numbers)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (bindings--define-key menu [global] + (menu-bar-make-mm-toggle global-display-line-numbers-mode + "Global Line Numbers Mode" + "Set line numbers globally")) + menu)) (defvar menu-bar-showhide-menu (let ((menu (make-sparse-keymap "Show/Hide"))) (bindings--define-key menu [display-line-numbers] `(menu-item "Line Numbers for All Lines" - ,(lambda () - (interactive) - (toggle-display-line-numbers)) - :help "Show the line number alongside each line" - :button (:toggle . display-line-numbers))) + ,menu-bar-showhide-line-numbers-menu)) (bindings--define-key menu [column-number-mode] (menu-bar-make-mm-toggle column-number-mode @@ -2375,10 +2420,6 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." ;; `setup-specified-language-environment', for instance, ;; expects this to be set from a menu keymap. (setq last-command-event (car (last event))) - ;; Update `this-command' and run `pre-command-hook' so that - ;; things like `delete-selection-pre-hook' will work correctly. - (setq this-command cmd) - (run-hooks 'pre-command-hook) ;; mouse-major-mode-menu was using `command-execute' instead. (call-interactively cmd)))) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 4d4e8a809e1..fe93fc32ad3 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -945,6 +945,7 @@ If EXTERNAL, browse the URL using `shr-external-browser'." (when (and (buffer-name buffer) (not (plist-get status :error))) (url-store-in-cache image-buffer) + (goto-char (point-min)) (when (or (search-forward "\n\n" nil t) (search-forward "\r\n\r\n" nil t)) (let ((data (shr-parse-image-data))) @@ -998,7 +999,7 @@ element is the data blob and the second element is the content-type." (create-image data nil t :ascent 100 :format content-type)) ((eq content-type 'image/svg+xml) - (create-image data 'imagemagick t :ascent 100)) + (create-image data 'svg t :ascent 100)) ((eq size 'full) (ignore-errors (shr-rescale-image data content-type diff --git a/lisp/password-cache.el b/lisp/password-cache.el index 7be3c6fdb6f..cbc248b9ecf 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -66,7 +66,7 @@ Whether passwords are cached at all is controlled by `password-cache'." :type '(choice (const :tag "Never" nil) (integer :tag "Seconds"))) -(defvar password-data (make-vector 7 0)) +(defvar password-data (make-hash-table :test #'equal)) (defun password-read-from-cache (key) "Obtain passphrase for KEY from time-limited passphrase cache. @@ -74,20 +74,20 @@ Custom variables `password-cache' and `password-cache-expiry' regulate cache behavior." (and password-cache key - (symbol-value (intern-soft key password-data)))) + (gethash key password-data))) ;;;###autoload (defun password-in-cache-p (key) "Check if KEY is in the cache." (and password-cache key - (intern-soft key password-data))) + (gethash key password-data))) (defun password-read (prompt &optional key) "Read password, for use with KEY, from user, or from cache if wanted. KEY indicate the purpose of the password, so the cache can -separate passwords. The cache is not used if KEY is nil. It is -typically a string. +separate passwords. The cache is not used if KEY is nil. +KEY is typically a string but can be anything (compared via `equal'). The variable `password-cache' control whether the cache is used." (or (password-read-from-cache key) (read-passwd prompt))) @@ -115,29 +115,27 @@ but can be invoked at any time to forcefully remove passwords from the cache. This may be useful when it has been detected that a password is invalid, so that `password-read' query the user again." - (let ((sym (intern-soft key password-data))) - (when sym - (let ((password (symbol-value sym))) - (when (stringp password) - (if (fboundp 'clear-string) - (clear-string password) - (fillarray password ?_))) - (unintern key password-data))))) + (let ((password (gethash key password-data))) + (when (stringp password) + (if (fboundp 'clear-string) + (clear-string password) + (fillarray password ?_))) + (remhash key password-data))) (defun password-cache-add (key password) "Add password to cache. The password is removed by a timer after `password-cache-expiry' seconds." - (when (and password-cache-expiry (null (intern-soft key password-data))) + (when (and password-cache-expiry (null (gethash key password-data))) (run-at-time password-cache-expiry nil #'password-cache-remove key)) - (set (intern key password-data) password) + (puthash key password password-data) nil) (defun password-reset () "Clear the password cache." (interactive) - (fillarray password-data 0)) + (clrhash password-data)) (provide 'password-cache) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 22f5b906e4e..59dc96af030 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6089,14 +6089,8 @@ comment at the start of cc-engine.el for more info." (defsubst c-clear-found-types () ;; Clears `c-found-types'. - (setq c-found-types (make-vector 53 0))) - -(defun c-copy-found-types () - (let ((copy (make-vector 53 0))) - (mapatoms (lambda (sym) - (intern (symbol-name sym) copy)) - c-found-types) - copy)) + (setq c-found-types + (make-hash-table :test #'equal :weakness nil))) (defun c-add-type (from to) ;; Add the given region as a type in `c-found-types'. If the region @@ -6110,29 +6104,27 @@ comment at the start of cc-engine.el for more info." ;; ;; This function might do hidden buffer changes. (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) - (unless (intern-soft type c-found-types) - (unintern (substring type 0 -1) c-found-types) - (intern type c-found-types)))) + (unless (gethash type c-found-types) + (remhash (substring type 0 -1) c-found-types) + (puthash type t c-found-types)))) (defun c-unfind-type (name) ;; Remove the "NAME" from c-found-types, if present. - (unintern name c-found-types)) + (remhash name c-found-types)) (defsubst c-check-type (from to) ;; Return non-nil if the given region contains a type in ;; `c-found-types'. ;; ;; This function might do hidden buffer changes. - (intern-soft (c-syntactic-content from to c-recognize-<>-arglists) - c-found-types)) + (gethash (c-syntactic-content from to c-recognize-<>-arglists) c-found-types)) (defun c-list-found-types () ;; Return all the types in `c-found-types' as a sorted list of ;; strings. (let (type-list) - (mapatoms (lambda (type) - (setq type-list (cons (symbol-name type) - type-list))) + (maphash (lambda (type _) + (setq type-list (cons type type-list))) c-found-types) (sort type-list 'string-lessp))) @@ -7066,7 +7058,7 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (let ((start (point)) - (old-found-types (c-copy-found-types)) + (old-found-types (copy-hash-table c-found-types)) ;; If `c-record-type-identifiers' is set then activate ;; recording of any found types that constitute an argument in ;; the arglist. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 66f2575f49f..b35d33a5fd3 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1182,10 +1182,15 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char match-pos) (backward-char) (c-backward-token-2) - (or (looking-at c-block-stmt-2-key) - (looking-at c-block-stmt-1-2-key) - (looking-at c-typeof-key)))) - (cons nil t)) + (cond + ((looking-at c-paren-stmt-key) + ;; Allow comma separated <> arglists in for statements. + (cons nil nil)) + ((or (looking-at c-block-stmt-2-key) + (looking-at c-block-stmt-1-2-key) + (looking-at c-typeof-key)) + (cons nil t)) + (t nil))))) ;; Near BOB. ((<= match-pos (point-min)) (cons 'arglist t)) @@ -1226,13 +1231,16 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Got a cached hit in some other type of arglist. (type (cons 'arglist t)) - (not-front-decl + ((and not-front-decl ;; The point is within the range of a previously ;; encountered type decl expression, so the arglist ;; is probably one that contains declarations. ;; However, if `c-recognize-paren-inits' is set it ;; might also be an initializer arglist. - ;; + (or (not c-recognize-paren-inits) + (save-excursion + (goto-char match-pos) + (not (c-back-over-member-initializers))))) ;; The result of this check is cached with a char ;; property on the match token, so that we can look ;; it up again when refontifying single lines in a @@ -1243,17 +1251,21 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Got an open paren preceded by an arith operator. ((and (eq (char-before match-pos) ?\() (save-excursion + (goto-char match-pos) (and (zerop (c-backward-token-2 2)) (looking-at c-arithmetic-op-regexp)))) (cons nil nil)) ;; In a C++ member initialization list. ((and (eq (char-before match-pos) ?,) (c-major-mode-is 'c++-mode) - (save-excursion (c-back-over-member-initializers))) + (save-excursion + (goto-char match-pos) + (c-back-over-member-initializers))) (c-put-char-property (1- match-pos) 'c-type 'c-not-decl) (cons 'not-decl nil)) ;; At start of a declaration inside a declaration paren. ((save-excursion + (goto-char match-pos) (and (memq (char-before match-pos) '(?\( ?\,)) (c-go-up-list-backward match-pos) (eq (char-after) ?\() diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index bf0439ffe8a..0bf89b9a36a 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1539,6 +1539,21 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (setq new-pos capture-opener)) (and (/= new-pos pos) new-pos))) +(defun c-fl-decl-end (pos) + ;; If POS is inside a declarator, return the end of the token that follows + ;; the declarator, otherwise return nil. + (goto-char pos) + (let ((lit-start (c-literal-start)) + pos1) + (if lit-start (goto-char lit-start)) + (c-backward-syntactic-ws) + (when (setq pos1 (c-on-identifier)) + (goto-char pos1) + (when (and (c-forward-declarator) + (eq (c-forward-token-2) 0)) + (c-backward-syntactic-ws) + (point))))) + (defun c-change-expand-fl-region (_beg _end _old-len) ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock ;; region. This will usually be the smallest sequence of whole lines @@ -1552,18 +1567,16 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (setq c-new-BEG (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) c-new-END - (save-excursion - (goto-char c-new-END) - (if (bolp) - (point) - (c-point 'bonl c-new-END)))))) + (or (c-fl-decl-end c-new-END) + (c-point 'bonl (max (1- c-new-END) (point-min))))))) (defun c-context-expand-fl-region (beg end) ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a ;; "local" declaration containing BEG (see `c-fl-decl-start') or BOL BEG is ;; in. NEW-END is beginning of the line after the one END is in. - (cons (or (c-fl-decl-start beg) (c-point 'bol beg)) - (c-point 'bonl end))) + (c-save-buffer-state () + (cons (or (c-fl-decl-start beg) (c-point 'bol beg)) + (or (c-fl-decl-end end) (c-point 'bonl (1- end)))))) (defun c-before-context-fl-expand-region (beg end) ;; Expand the region (BEG END) as specified by diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c0f1aaf39d4..c69eca22413 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3734,7 +3734,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\(\\`\n?\\|^\n\\)=" ; POD "\\|" ;; One extra () before this: - "<<" ; HERE-DOC + "<<~?" ; HERE-DOC "\\(" ; 1 + 1 ;; First variant "BLAH" or just ``. "[ \t]*" ; Yes, whitespace is allowed! @@ -4000,7 +4000,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq b (point)) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random - (or (and (re-search-forward (concat "^" qtag "$") + (or (and (re-search-forward (concat "^[ \t]*" qtag "$") stop-point 'toend) ;;;(eq (following-char) ?\n) ; XXXX WHY??? ) diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el index 389ddfca6b1..7a666e95297 100644 --- a/lisp/progmodes/ld-script.el +++ b/lisp/progmodes/ld-script.el @@ -85,10 +85,12 @@ ;; 3.4.5 Other Linker Script Commands "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION" "INHIBIT_COMMON_ALLOCATION" "INSERT" "AFTER" "BEFORE" - "NOCROSSREFS" "OUTPUT_ARCH" "LD_FEATURE" - ;; 3.5.2 PROVIDE + "NOCROSSREFS" "NOCROSSREFS_TO" "OUTPUT_ARCH" "LD_FEATURE" + ;; 3.5.2 HIDDEN + "HIDDEN" + ;; 3.5.3 PROVIDE "PROVIDE" - ;; 3.5.3 PROVIDE_HIDDEN + ;; 3.5.4 PROVIDE_HIDDEN "PROVIDE_HIDDEN" ;; 3.6 SECTIONS Command "SECTIONS" @@ -142,6 +144,7 @@ "DEFINED" "LENGTH" "len" "l" "LOADADDR" + "LOG2CEIL" "MAX" "MIN" "NEXT" diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 3def37a2ea8..6197a53ee66 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -213,25 +213,6 @@ (regexp-opt perl--syntax-exp-intro-keywords) "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*"))) -;; FIXME: handle here-docs and regexps. -;; <<EOF <<"EOF" <<'EOF' (no space) -;; see `man perlop' -;; ?...? -;; /.../ -;; m [...] -;; m /.../ -;; q /.../ = '...' -;; qq /.../ = "..." -;; qx /.../ = `...` -;; qr /.../ = precompiled regexp =~=~ m/.../ -;; qw /.../ -;; s /.../.../ -;; s <...> /.../ -;; s '...'...' -;; tr /.../.../ -;; y /.../.../ -;; -;; <file*glob> (defun perl-syntax-propertize-function (start end) (let ((case-fold-search nil)) (goto-char start) @@ -324,23 +305,25 @@ ((concat "\\(?:" ;; << "EOF", << 'EOF', or << \EOF - "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)" + "<<\\(~\\)?[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)" ;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to ;; disambiguate with the left-bitshift operator. - "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:\\sw+\\)\\)" + "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)" ".*\\(\n\\)") - (3 (let* ((st (get-text-property (match-beginning 3) 'syntax-table)) - (name (match-string 1))) - (goto-char (match-end 1)) + (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table)) + (name (match-string 2)) + (indented (match-beginning 1))) + (goto-char (match-end 2)) (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) ;; Leave the property of the newline unchanged. st (cons (car (string-to-syntax "< c")) ;; Remember the names of heredocs found on this line. - (cons (pcase (aref name 0) - (`?\\ (substring name 1)) - ((or `?\" `?\' `?\`) (substring name 1 -1)) - (_ name)) + (cons (cons (pcase (aref name 0) + (`?\\ (substring name 1)) + ((or `?\" `?\' `?\`) (substring name 1 -1)) + (_ name)) + indented) (cdr st))))))) ;; We don't call perl-syntax-propertize-special-constructs directly ;; from the << rule, because there might be other elements (between @@ -383,7 +366,9 @@ (goto-char (nth 8 state))) (while (and names (re-search-forward - (concat "^" (regexp-quote (pop names)) "\n") + (pcase-let ((`(,name . ,indented) (pop names))) + (concat "^" (if indented "[ \t]*") + (regexp-quote name) "\n")) limit 'move)) (unless names (put-text-property (1- (point)) (point) 'syntax-table diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 35b555e6879..23e79f6ac59 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1683,6 +1683,7 @@ with your script for an edit-interpret-debug cycle." ((string-match "[.]sh\\>" buffer-file-name) "sh") ((string-match "[.]bash\\>" buffer-file-name) "bash") ((string-match "[.]ksh\\>" buffer-file-name) "ksh") + ((string-match "[.]mkshrc\\>" buffer-file-name) "mksh") ((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh") ((string-match "[.]zsh\\(rc\\|env\\)?\\>" buffer-file-name) "zsh") ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh") diff --git a/lisp/register.el b/lisp/register.el index 7cc3ccd870c..e395963f56a 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -164,6 +164,10 @@ display such a window regardless." help-chars) (unless (get-buffer-window buffer) (register-preview buffer 'show-empty))) + (when (or (eq ?\C-g last-input-event) + (eq 'escape last-input-event) + (eq ?\C-\[ last-input-event)) + (keyboard-quit)) (if (characterp last-input-event) last-input-event (error "Non-character input-event"))) (and (timerp timer) (cancel-timer timer)) diff --git a/lisp/replace.el b/lisp/replace.el index 64dfe7da22d..a5024943e64 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1395,6 +1395,11 @@ invoke `occur'." "Show all lines in the current buffer containing a match for REGEXP. If a match spreads across multiple lines, all those lines are shown. +Each match is extended to include complete lines. Only non-overlapping +matches are considered. (Note that extending matches to complete +lines could cause some of the matches to overlap; if so, they will not +be shown as separate matches.) + Each line is displayed with NLINES lines before and after, or -NLINES before if NLINES is negative. NLINES defaults to `list-matching-lines-default-context-lines'. diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 7b0588dfead..fdfd5c61be9 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -696,6 +696,10 @@ Optional argument PROPS specifies other text properties to apply." ;; Create an "clean" ruler. (ruler (propertize + ;; FIXME: `make-string' returns a unibyte string if it's ASCII-only, + ;; which prevents further `aset' from inserting non-ASCII chars, + ;; hence the need for `string-to-multibyte'. + ;; http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00841.html (string-to-multibyte (make-string w ruler-mode-basic-graduation-char)) 'face 'ruler-mode-default diff --git a/lisp/startup.el b/lisp/startup.el index bc60bbd08b8..0fbba1bea23 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1432,6 +1432,7 @@ settings will be marked as \"CHANGED outside of Customize\"." (let ((no-vals '("no" "off" "false" "0")) (settings '(("menuBar" "MenuBar" menu-bar-mode nil) ("toolBar" "ToolBar" tool-bar-mode nil) + ("scrollBar" "ScrollBar" scroll-bar-mode nil) ("cursorBlink" "CursorBlink" no-blinking-cursor t)))) (dolist (x settings) (if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals) diff --git a/lisp/subr.el b/lisp/subr.el index d9d918ed12d..b3f9f902349 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1789,7 +1789,8 @@ Return the new history list. If MAXELT is non-nil, it specifies the maximum length of the history. Otherwise, the maximum history length is the value of the `history-length' property on symbol HISTORY-VAR, if set, or the value of the `history-length' -variable. +variable. The possible values of maximum length have the same meaning as +the values of `history-length'. Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil. If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even if it is empty or a duplicate." @@ -1998,6 +1999,25 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label." ;; "Return the name of the file from which AUTOLOAD will be loaded. ;; \n\(fn AUTOLOAD)") +(defun define-symbol-prop (symbol prop val) + "Define the property PROP of SYMBOL to be VAL. +This is to `put' what `defalias' is to `fset'." + ;; Can't use `cl-pushnew' here (nor `push' on (cdr foo)). + ;; (cl-pushnew symbol (alist-get prop + ;; (alist-get 'define-symbol-props + ;; current-load-list))) + (let ((sps (assq 'define-symbol-props current-load-list))) + (unless sps + (setq sps (list 'define-symbol-props)) + (push sps current-load-list)) + (let ((ps (assq prop sps))) + (unless ps + (setq ps (list prop)) + (setcdr sps (cons ps (cdr sps)))) + (unless (member symbol (cdr ps)) + (setcdr ps (cons symbol (cdr ps)))))) + (put symbol prop val)) + (defun symbol-file (symbol &optional type) "Return the name of the file that defined SYMBOL. The value is normally an absolute file name. It can also be nil, @@ -2007,47 +2027,30 @@ file name without extension. If TYPE is nil, then any kind of definition is acceptable. If TYPE is `defun', `defvar', or `defface', that specifies function -definition, variable definition, or face definition only." +definition, variable definition, or face definition only. +Otherwise TYPE is assumed to be a symbol property." (if (and (or (null type) (eq type 'defun)) (symbolp symbol) (autoloadp (symbol-function symbol))) (nth 1 (symbol-function symbol)) - (let ((files load-history) - file match) - (while files - (if (if type - (if (eq type 'defvar) - ;; Variables are present just as their names. - (member symbol (cdr (car files))) - ;; Other types are represented as (TYPE . NAME). - (member (cons type symbol) (cdr (car files)))) - ;; We accept all types, so look for variable def - ;; and then for any other kind. - (or (member symbol (cdr (car files))) - (and (setq match (rassq symbol (cdr (car files)))) - (not (eq 'require (car match)))))) - (setq file (car (car files)) files nil)) - (setq files (cdr files))) - file))) - -(defun method-files (method) - "Return a list of files where METHOD is defined by `cl-defmethod'. -The list will have entries of the form (FILE . (METHOD ...)) -where (METHOD ...) contains the qualifiers and specializers of -the method and is a suitable argument for -`find-function-search-for-symbol'. Filenames are absolute." - (let ((files load-history) - result) - (while files - (let ((defs (cdr (car files)))) - (while defs - (let ((def (car defs))) - (if (and (eq (car-safe def) 'cl-defmethod) - (eq (cadr def) method)) - (push (cons (car (car files)) (cdr def)) result))) - (setq defs (cdr defs)))) - (setq files (cdr files))) - result)) + (catch 'found + (pcase-dolist (`(,file . ,elems) load-history) + (when (if type + (if (eq type 'defvar) + ;; Variables are present just as their names. + (member symbol elems) + ;; Many other types are represented as (TYPE . NAME). + (or (member (cons type symbol) elems) + (memq symbol (alist-get type + (alist-get 'define-symbol-props + elems))))) + ;; We accept all types, so look for variable def + ;; and then for any other kind. + (or (member symbol elems) + (let ((match (rassq symbol elems))) + (and match + (not (eq 'require (car match))))))) + (throw 'found file)))))) (defun locate-library (library &optional nosuffix path interactive-call) "Show the precise file name of Emacs library LIBRARY. diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 596570ca4e2..cdc2af4a7ad 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -4889,7 +4889,7 @@ If optional argument STATE is positive, turn borders on." (select-window (posn-window (event-start last-input-event))) (list last-input-event (if (display-popup-menus-p) - (x-popup-menu last-nonmenu-event artist-popup-menu-table) + (x-popup-menu t artist-popup-menu-table) 'no-popup-menus)))) (if (eq op 'no-popup-menus) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index b37e6dce1af..19cb7b4fea8 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -835,7 +835,7 @@ cannot be completed sensibly: `custom-ident', (defface css-selector '((t :inherit font-lock-function-name-face)) "Face to use for selectors." :group 'css) -(defface css-property '((t :inherit font-lock-variable-name-face)) +(defface css-property '((t :inherit font-lock-keyword-face)) "Face to use for properties." :group 'css) (defface css-proprietary-property '((t :inherit (css-property italic))) diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 4912db6c53b..0edc93c9649 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -1,4 +1,4 @@ -;;; url-cookie.el --- URL cookie support +;;; url-cookie.el --- URL cookie support -*- lexical-binding:t -*- ;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc. @@ -227,21 +227,17 @@ telling Microsoft that." :group 'url-cookie) (defun url-cookie-host-can-set-p (host domain) - (let ((last nil) - (case-fold-search t)) - (cond - ((string= host domain) ; Apparently netscape lets you do this - t) - ((zerop (length domain)) - nil) - (t - ;; Remove the dot from wildcard domains before matching. - (when (eq ?. (aref domain 0)) - (setq domain (substring domain 1))) - (and (url-domsuf-cookie-allowed-p domain) - ;; Need to check and make sure the host is actually _in_ the - ;; domain it wants to set a cookie for though. - (string-match (concat (regexp-quote domain) "$") host)))))) + (cond + ((string= host domain) ; Apparently netscape lets you do this + t) + ((zerop (length domain)) + nil) + (t + ;; Remove the dot from wildcard domains before matching. + (when (eq ?. (aref domain 0)) + (setq domain (substring domain 1))) + (and (url-domsuf-cookie-allowed-p domain) + (string-suffix-p domain host 'ignore-case))))) (defun url-cookie-handle-set-cookie (str) (setq url-cookies-changed-since-last-save t) @@ -380,8 +376,8 @@ instead delete all cookies that do not match REGEXP." "Display a buffer listing the current URL cookies, if there are any. Use \\<url-cookie-mode-map>\\[url-cookie-delete] to remove cookies." (interactive) - (when (and (null url-cookie-secure-storage) - (null url-cookie-storage)) + (unless (or url-cookie-secure-storage + url-cookie-storage) (error "No cookies are defined")) (pop-to-buffer "*url cookies*") @@ -442,20 +438,13 @@ Use \\<url-cookie-mode-map>\\[url-cookie-delete] to remove cookies." (forward-line 1) (point))))) -(defun url-cookie-quit () - "Kill the current buffer." - (interactive) - (kill-buffer (current-buffer))) - (defvar url-cookie-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'url-cookie-quit) (define-key map [delete] 'url-cookie-delete) (define-key map [(control k)] 'url-cookie-delete) map)) -(define-derived-mode url-cookie-mode nil "URL Cookie" +(define-derived-mode url-cookie-mode special-mode "URL Cookie" "Mode for listing cookies. \\{url-cookie-mode-map}" diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 21c39c85ca8..f94f8a6d4d2 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -938,15 +938,15 @@ It has the following disadvantages: - cannot use `diff -w' because the weighting causes added spaces in a line to be represented as added copies of some line, so `diff -w' can't do the right thing any more. -- may in degenerate cases take a 1KB input region and turn it into a 1MB - file to pass to diff.") +- Is a bit more costly (may in degenerate cases use temp files that are 10x + larger than the refined regions).") (defun smerge--refine-forward (n) (let ((case-fold-search nil) (re "[[:upper:]]?[[:lower:]]+\\|[[:upper:]]+\\|[[:digit:]]+\\|.\\|\n")) (when (and smerge-refine-ignore-whitespace ;; smerge-refine-weight-hack causes additional spaces to - ;; appear as additional lines as well, so even if diff ignore + ;; appear as additional lines as well, so even if diff ignores ;; whitespace changes, it'll report added/removed lines :-( (not smerge-refine-weight-hack)) (setq re (concat "[ \t]*\\(?:" re "\\)"))) @@ -954,6 +954,8 @@ It has the following disadvantages: (unless (looking-at re) (error "Smerge refine internal error")) (goto-char (match-end 0))))) +(defvar smerge--refine-long-words) + (defun smerge--refine-chopup-region (beg end file &optional preproc) "Chopup the region into small elements, one per line. Save the result into FILE. @@ -976,18 +978,46 @@ chars to try and eliminate some spurious differences." (subst-char-in-region (point-min) (point-max) ?\n ?\s)) (goto-char (point-min)) (while (not (eobp)) - (funcall smerge-refine-forward-function 1) - (let ((s (if (prog2 (forward-char -1) (bolp) (forward-char 1)) - nil - (buffer-substring (line-beginning-position) (point))))) - ;; We add \n after each char except after \n, so we get - ;; one line per text char, where each line contains - ;; just one char, except for \n chars which are - ;; represented by the empty line. - (unless (eq (char-before) ?\n) (insert ?\n)) - ;; HACK ALERT!! - (if smerge-refine-weight-hack - (dotimes (_i (1- (length s))) (insert s "\n"))))) + (cl-assert (bolp)) + (let ((start (point))) + (funcall smerge-refine-forward-function 1) + (let ((len (- (point) start))) + (cl-assert (>= len 1)) + ;; We add \n after each chunk except after \n, so we get + ;; one line per text chunk, where each line contains + ;; just one chunk, except for \n chars which are + ;; represented by the empty line. + (unless (bolp) (insert ?\n)) + (when (and smerge-refine-weight-hack (> len 1)) + (let ((s (buffer-substring-no-properties start (point)))) + ;; The weight-hack inserts N copies of words of size N, + ;; so it naturally suffers from an O(N²) blow up. + ;; To circumvent this, we map each long word + ;; to a shorter (but still unique) replacement. + ;; Another option would be to change smerge--refine-forward + ;; so it chops up long words into smaller ones. + (when (> len 8) + (let ((short (gethash s smerge--refine-long-words))) + (unless short + ;; To avoid accidental conflicts with ≤8 words, + ;; we make sure the replacement is >8 chars. Overall, + ;; this should bound the blowup factor to ~10x, + ;; tho if those chars end up encoded as multiple bytes + ;; each, it could probably still reach ~30x in + ;; pathological cases. + (setq short + (concat (substring s 0 7) + " " + (string + (+ ?0 + (hash-table-count + smerge--refine-long-words))) + "\n")) + (puthash s short smerge--refine-long-words)) + (delete-region start (point)) + (insert short) + (setq s short))) + (dotimes (_i (1- len)) (insert s))))))) (unless (bolp) (error "Smerge refine internal error")) (let ((coding-system-for-write 'emacs-internal)) (write-region (point-min) (point-max) file nil 'nomessage)))) @@ -1042,7 +1072,9 @@ used to replace chars to try and eliminate some spurious differences." (let* ((pos (point)) deactivate-mark ; The code does not modify any visible buffer. (file1 (make-temp-file "diff1")) - (file2 (make-temp-file "diff2"))) + (file2 (make-temp-file "diff2")) + (smerge--refine-long-words + (if smerge-refine-weight-hack (make-hash-table :test #'equal)))) (unless (markerp beg1) (setq beg1 (copy-marker beg1))) (unless (markerp beg2) (setq beg2 (copy-marker beg2))) ;; Chop up regions into smaller elements and save into files. @@ -1062,7 +1094,7 @@ used to replace chars to try and eliminate some spurious differences." ;; also and more importantly because otherwise it ;; may happen that diff doesn't behave like ;; smerge-refine-weight-hack expects it to. - ;; See http://thread.gmane.org/gmane.emacs.devel/82685. + ;; See http://thread.gmane.org/gmane.emacs.devel/82685, aka https://lists.gnu.org/archive/html/emacs-devel/2007-11/msg00401.html "-awd" "-ad") file1 file2)) ;; Process diff's output. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index c6d5b16caeb..4198b9bd0e7 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1,4 +1,4 @@ -;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE +;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE -*- lexical-binding: t -*- ;; Copyright (C) 2000-2017 Free Software Foundation, Inc. diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 038d78aafea..2f135773930 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -113,6 +113,7 @@ AC_DEFUN([gl_EARLY], # Code from module mktime-internal: # Code from module multiarch: # Code from module nocrash: + # Code from module nstrftime: # Code from module openat-h: # Code from module pipe2: # Code from module pselect: @@ -139,7 +140,6 @@ AC_DEFUN([gl_EARLY], # Code from module stdio: # Code from module stdlib: # Code from module stpcpy: - # Code from module strftime: # Code from module string: # Code from module strtoimax: # Code from module strtoll: @@ -314,6 +314,7 @@ AC_DEFUN([gl_INIT], fi gl_TIME_MODULE_INDICATOR([mktime]) gl_MULTIARCH + gl_FUNC_GNU_STRFTIME gl_FUNC_PIPE2 gl_UNISTD_MODULE_INDICATOR([pipe2]) gl_FUNC_PSELECT @@ -365,7 +366,6 @@ AC_DEFUN([gl_INIT], gl_PREREQ_STPCPY fi gl_STRING_MODULE_INDICATOR([stpcpy]) - gl_FUNC_GNU_STRFTIME gl_HEADER_STRING_H gl_FUNC_STRTOIMAX if test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then @@ -893,6 +893,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/mkostemp.c lib/mktime-internal.h lib/mktime.c + lib/nstrftime.c lib/openat-priv.h lib/openat-proc.c lib/openat.h @@ -924,7 +925,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/stdio.in.h lib/stdlib.in.h lib/stpcpy.c - lib/strftime.c lib/strftime.h lib/string.in.h lib/strtoimax.c @@ -1013,6 +1013,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/mktime.m4 m4/multiarch.m4 m4/nocrash.m4 + m4/nstrftime.m4 m4/off_t.m4 m4/pipe2.m4 m4/pselect.m4 @@ -1037,7 +1038,6 @@ AC_DEFUN([gl_FILE_LIST], [ m4/stdio_h.m4 m4/stdlib_h.m4 m4/stpcpy.m4 - m4/strftime.m4 m4/string_h.m4 m4/strtoimax.m4 m4/strtoll.m4 diff --git a/m4/strftime.m4 b/m4/nstrftime.m4 index d2dac9e2328..d2dac9e2328 100644 --- a/m4/strftime.m4 +++ b/m4/nstrftime.m4 diff --git a/nextstep/INSTALL b/nextstep/INSTALL index 799cd4d866a..b7e84e018ee 100644 --- a/nextstep/INSTALL +++ b/nextstep/INSTALL @@ -21,15 +21,23 @@ In the top-level directory, use: (On macOS, --with-ns is enabled by default.) -This will compile all the files, but emacs will not be able to be run except -in -nw (terminal) mode. +Then run: -In order to run Emacs.app, you must run: + make + +This will compile all the files. + +In order to run Emacs, you must run: + + src/emacs + +In order to install Emacs, you must run: make install This will assemble the app in nextstep/Emacs.app (i.e., the --prefix -argument has no effect in this case). +argument has no effect in this case). You can then move the Emacs.app +bundle to a location of your choice. If you pass the --disable-ns-self-contained option to configure, the lisp files will be installed under whatever 'prefix' is set to (defaults to diff --git a/src/alloc.c b/src/alloc.c index 5d02bb3cfbb..73d33564843 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6943,7 +6943,7 @@ sweep_symbols (void) symbol_free_list = NULL; for (int i = 0; i < ARRAYELTS (lispsym); i++) - lispsym[i].gcmarkbit = 0; + lispsym[i].s.gcmarkbit = 0; for (sblk = symbol_block; sblk; sblk = *sprev) { diff --git a/src/lisp.h b/src/lisp.h index 9464bf8559f..cffaf954b3b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -838,13 +838,13 @@ make_lisp_symbol (struct Lisp_Symbol *sym) INLINE Lisp_Object builtin_lisp_symbol (int index) { - return make_lisp_symbol (lispsym + index); + return make_lisp_symbol (&lispsym[index].s); } INLINE void (CHECK_SYMBOL) (Lisp_Object x) { - lisp_h_CHECK_SYMBOL (x); + lisp_h_CHECK_SYMBOL (x); } /* In the size word of a vector, this bit means the vector has been marked. */ diff --git a/src/lread.c b/src/lread.c index 901e40b3489..dbaadce4b40 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3479,6 +3479,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (! NILP (result)) return unbind_to (count, result); } + if (!quoted && multibyte) + { + int ch = STRING_CHAR ((unsigned char *) read_buffer); + switch (ch) + { + case 0x2018: /* LEFT SINGLE QUOTATION MARK */ + case 0x2019: /* RIGHT SINGLE QUOTATION MARK */ + case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */ + case 0x201C: /* LEFT DOUBLE QUOTATION MARK */ + case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */ + case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */ + case 0x301E: /* DOUBLE PRIME QUOTATION MARK */ + case 0xFF02: /* FULLWIDTH QUOTATION MARK */ + case 0xFF07: /* FULLWIDTH APOSTROPHE */ + xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"), + CALLN (Fstring, make_number (ch))); + } + } { Lisp_Object result; ptrdiff_t nbytes = p - read_buffer; diff --git a/src/minibuf.c b/src/minibuf.c index d4128ce01c1..010152930bc 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -497,6 +497,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Fcons (Vminibuffer_history_position, Fcons (Vminibuffer_history_variable, minibuf_save_list)))))); + minibuf_save_list + = Fcons (Fthis_command_keys_vector (), minibuf_save_list); record_unwind_protect_void (read_minibuf_unwind); minibuf_level++; @@ -836,6 +838,11 @@ read_minibuf_unwind (void) Fset_buffer (XWINDOW (window)->contents); /* Restore prompt, etc, from outer minibuffer level. */ + Lisp_Object key_vec = Fcar (minibuf_save_list); + eassert (VECTORP (key_vec)); + this_command_key_count = XFASTINT (Flength (key_vec)); + this_command_keys = key_vec; + minibuf_save_list = Fcdr (minibuf_save_list); minibuf_prompt = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list)); diff --git a/src/nsterm.m b/src/nsterm.m index a3c7031331a..36d906a7cec 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5497,6 +5497,19 @@ ns_term_shutdown (int sig) object:nil]; #endif +#ifdef NS_IMPL_COCOA + if ([NSApp activationPolicy] == NSApplicationActivationPolicyProhibited) { + /* Set the app's activation policy to regular when we run outside + of a bundle. This is already done for us by Info.plist when we + run inside a bundle. */ + [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular]; + [NSApp setApplicationIconImage: + [EmacsImage + allocInitFromFile: + build_string("icons/hicolor/128x128/apps/emacs.png")]]; + } +#endif + ns_send_appdefined (-2); } diff --git a/src/regex.c b/src/regex.c index fb48765c96c..0dbb47309e4 100644 --- a/src/regex.c +++ b/src/regex.c @@ -1942,7 +1942,7 @@ struct range_table_work_area returned. If name is not a valid character class name zero, or RECC_ERROR, is returned. - Otherwise, if *strp doesn’t begin with "[:name:]", -1 is returned. + Otherwise, if *strp doesn't begin with "[:name:]", -1 is returned. The function can be used on ASCII and multibyte (UTF-8-encoded) strings. */ @@ -1954,8 +1954,8 @@ re_wctype_parse (const unsigned char **strp, unsigned limit) if (limit < 4 || beg[0] != '[' || beg[1] != ':') return -1; - beg += 2; /* skip opening ‘[:’ */ - limit -= 3; /* opening ‘[:’ and half of closing ‘:]’; --limit handles rest */ + beg += 2; /* skip opening "[:" */ + limit -= 3; /* opening "[:" and half of closing ":]"; --limit handles rest */ for (it = beg; it[0] != ':' || it[1] != ']'; ++it) if (!--limit) return -1; @@ -1985,7 +1985,7 @@ re_wctype_parse (const unsigned char **strp, unsigned limit) 2 [:cntrl:] 1 [:ff:] - If you update this list, consider also updating chain of or’ed conditions + If you update this list, consider also updating chain of or'ed conditions in execute_charset function. */ diff --git a/src/regex.h b/src/regex.h index 1d439de259c..5e3a79763ec 100644 --- a/src/regex.h +++ b/src/regex.h @@ -21,7 +21,7 @@ #define _REGEX_H 1 #if defined emacs && (defined _REGEX_RE_COMP || defined _LIBC) -/* We’re not defining re_set_syntax and using a different prototype of +/* We're not defining re_set_syntax and using a different prototype of re_compile_pattern when building Emacs so fail compilation early with a (somewhat helpful) error message when conflict is detected. */ # error "_REGEX_RE_COMP nor _LIBC can be defined if emacs is defined." diff --git a/src/xdisp.c b/src/xdisp.c index 3e5657ffe6f..422912e57a6 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32745,7 +32745,7 @@ even if the actual number needs less space. The default value of nil means compute the space dynamically. Any other value is treated as nil. */); Vdisplay_line_numbers_width = Qnil; - DEFSYM (Qdisplay_line_numbers_width, "display-line-number-width"); + DEFSYM (Qdisplay_line_numbers_width, "display-line-numbers-width"); Fmake_variable_buffer_local (Qdisplay_line_numbers_width); DEFVAR_LISP ("display-line-numbers-current-absolute", diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 2634777c7db..9753029f198 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -215,7 +215,7 @@ (ert-deftest auth-source-test-remembrances-of-things-past () (let ((password-cache t) - (password-data (make-vector 7 0))) + (password-data (copy-hash-table password-data))) (auth-source-remember '(:host "wedd") '(4 5 6)) (should (auth-source-remembered-p '(:host "wedd"))) (should-not (auth-source-remembered-p '(:host "xedd"))) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index bd1816172e7..cd58edaa3f8 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -38,19 +38,21 @@ (file "test") (full-name (expand-file-name file dir)) (regexp "bar") - (dired-always-read-filesystem t)) + (dired-always-read-filesystem t) buffers) (if (file-exists-p dir) (delete-directory dir 'recursive)) (make-directory dir) (with-temp-file full-name (insert "foo")) - (find-file-noselect full-name) - (dired dir) + (push (find-file-noselect full-name) buffers) + (push (dired dir) buffers) (with-temp-file full-name (insert "bar")) (dired-mark-files-containing-regexp regexp) (unwind-protect (should (equal (dired-get-marked-files nil nil nil 'distinguish-1-mark) `(t ,full-name))) ;; Clean up + (dolist (buf buffers) + (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory dir 'recursive)))) (ert-deftest dired-test-bug25609 () @@ -60,7 +62,8 @@ (target (expand-file-name (file-name-nondirectory from) to)) (nested (expand-file-name (file-name-nondirectory from) target)) (dired-dwim-target t) - (dired-recursive-copies 'always)) ; Don't prompt me. + (dired-recursive-copies 'always) ; Don't prompt me. + buffers) (advice-add 'dired-query ; Don't ask confirmation to overwrite a file. :override (lambda (_sym _prompt &rest _args) (setq dired-query t)) @@ -70,8 +73,8 @@ (lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap) init) '((name . "advice-completing-read"))) - (dired to) - (dired-other-window temporary-file-directory) + (push (dired to) buffers) + (push (dired-other-window temporary-file-directory) buffers) (dired-goto-file from) (dired-do-copy) (dired-do-copy); Again. @@ -79,18 +82,80 @@ (progn (should (file-exists-p target)) (should-not (file-exists-p nested))) + (dolist (buf buffers) + (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory from 'recursive) (delete-directory to 'recursive) (advice-remove 'dired-query "advice-dired-query") (advice-remove 'completing-read "advice-completing-read")))) -(ert-deftest dired-test-bug27243 () - "Test for http://debbugs.gnu.org/27243 ." +;; (ert-deftest dired-test-bug27243 () +;; "Test for http://debbugs.gnu.org/27243 ." +;; (let ((test-dir (make-temp-file "test-dir-" t)) +;; (dired-auto-revert-buffer t) buffers) +;; (with-current-buffer (find-file-noselect test-dir) +;; (make-directory "test-subdir")) +;; (push (dired test-dir) buffers) +;; (unwind-protect +;; (let ((buf (current-buffer)) +;; (pt1 (point)) +;; (test-file (concat (file-name-as-directory "test-subdir") +;; "test-file"))) +;; (write-region "Test" nil test-file nil 'silent nil 'excl) +;; ;; Sanity check: point should now be on the subdirectory. +;; (should (equal (dired-file-name-at-point) +;; (concat (file-name-as-directory test-dir) +;; (file-name-as-directory "test-subdir")))) +;; (push (dired-find-file) buffers) +;; (let ((pt2 (point))) ; Point is on test-file. +;; (switch-to-buffer buf) +;; ;; Sanity check: point should now be back on the subdirectory. +;; (should (eq (point) pt1)) +;; ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 +;; (push (dired-find-file) buffers) +;; (should (eq (point) pt2)) +;; ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 +;; (push (dired test-dir) buffers) +;; (should (eq (point) pt1)))) +;; (dolist (buf buffers) +;; (when (buffer-live-p buf) (kill-buffer buf))) +;; (delete-directory test-dir t)))) + +(ert-deftest dired-test-bug27243-01 () + "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ." + (let ((test-dir (make-temp-file "test-dir-" t)) + (dired-auto-revert-buffer t) buffers) + (with-current-buffer (find-file-noselect test-dir) + (make-directory "test-subdir")) + (push (dired test-dir) buffers) + (unwind-protect + (let ((buf (current-buffer)) + (pt1 (point)) + (test-file (concat (file-name-as-directory "test-subdir") + "test-file"))) + (write-region "Test" nil test-file nil 'silent nil 'excl) + ;; Sanity check: point should now be on the subdirectory. + (should (equal (dired-file-name-at-point) + (concat (file-name-as-directory test-dir) + (file-name-as-directory "test-subdir")))) + (push (dired-find-file) buffers) + (let ((pt2 (point))) ; Point is on test-file. + (switch-to-buffer buf) + ;; Sanity check: point should now be back on the subdirectory. + (should (eq (point) pt1)) + (push (dired-find-file) buffers) + (should (eq (point) pt2)))) + (dolist (buf buffers) + (when (buffer-live-p buf) (kill-buffer buf))) + (delete-directory test-dir t)))) + +(ert-deftest dired-test-bug27243-02 () + "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 ." (let ((test-dir (make-temp-file "test-dir-" t)) - (dired-auto-revert-buffer t)) + (dired-auto-revert-buffer t) buffers) (with-current-buffer (find-file-noselect test-dir) (make-directory "test-subdir")) - (dired test-dir) + (push (dired test-dir) buffers) (unwind-protect (let ((buf (current-buffer)) (pt1 (point)) @@ -101,17 +166,48 @@ (should (equal (dired-file-name-at-point) (concat (file-name-as-directory test-dir) (file-name-as-directory "test-subdir")))) - (dired-find-file) + (push (dired-find-file) buffers) (let ((pt2 (point))) ; Point is on test-file. (switch-to-buffer buf) ;; Sanity check: point should now be back on the subdirectory. (should (eq (point) pt1)) - ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 - (dired-find-file) - (should (eq (point) pt2)) - ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 - (dired test-dir) + (push (dired test-dir) buffers) (should (eq (point) pt1)))) + (dolist (buf buffers) + (when (buffer-live-p buf) (kill-buffer buf))) + (delete-directory test-dir t)))) + +(ert-deftest dired-test-bug27243-03 () + "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#61 ." + (let ((test-dir (make-temp-file "test-dir-" t)) + (dired-auto-revert-buffer t) + test-subdir1 test-subdir2 allbufs) + (unwind-protect + (progn + (with-current-buffer (find-file-noselect test-dir) + (push (current-buffer) allbufs) + (make-directory "test-subdir1") + (make-directory "test-subdir2") + (let ((test-file1 "test-file1") + (test-file2 "test-file2")) + (with-current-buffer (find-file-noselect "test-subdir1") + (push (current-buffer) allbufs) + (write-region "Test1" nil test-file1 nil 'silent nil 'excl)) + (with-current-buffer (find-file-noselect "test-subdir2") + (push (current-buffer) allbufs) + (write-region "Test2" nil test-file2 nil 'silent nil 'excl)))) + ;; Call find-file with a wild card and test point in each file. + (let ((buffers (find-file (concat (file-name-as-directory test-dir) + "*") + t))) + (dolist (buf buffers) + (let ((pt (with-current-buffer buf (point)))) + (switch-to-buffer (find-file-noselect test-dir)) + (find-file (buffer-name buf)) + (should (equal (point) pt)))) + (append buffers allbufs))) + (dolist (buf allbufs) + (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory test-dir t)))) (ert-deftest dired-test-bug27693 () @@ -168,5 +264,56 @@ (should (looking-at "src"))) (when (buffer-live-p buf) (kill-buffer buf))))) +(ert-deftest dired-test-bug27817 () + "Test for http://debbugs.gnu.org/27817 ." + (require 'em-ls) + (let ((orig eshell-ls-use-in-dired) + (dired-use-ls-dired 'unspecified) + buf insert-directory-program) + (unwind-protect + (progn + (customize-set-variable 'eshell-ls-use-in-dired t) + (should (setq buf (dired source-directory)))) + (customize-set-variable 'eshell-ls-use-in-dired orig) + (and (buffer-live-p buf) (kill-buffer))))) + +(ert-deftest dired-test-bug27631 () + "Test for http://debbugs.gnu.org/27631 ." + (let* ((dir (make-temp-file "bug27631" 'dir)) + (dir1 (expand-file-name "dir1" dir)) + (dir2 (expand-file-name "dir2" dir)) + (default-directory dir) + buf) + (unwind-protect + (progn + (make-directory dir1) + (make-directory dir2) + (with-temp-file (expand-file-name "a.txt" dir1)) + (with-temp-file (expand-file-name "b.txt" dir2)) + (setq buf (dired (expand-file-name "dir*/*.txt" dir))) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files))) + ;; Must work with ls-lisp ... + (require 'ls-lisp) + (kill-buffer buf) + (setq default-directory dir) + (let (ls-lisp-use-insert-directory-program) + (setq buf (dired (expand-file-name "dir*/*.txt" dir))) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files)))) + ;; ... And with em-ls as well. + (kill-buffer buf) + (setq default-directory dir) + (unload-feature 'ls-lisp 'force) + (require 'em-ls) + (let ((orig eshell-ls-use-in-dired)) + (customize-set-value 'eshell-ls-use-in-dired t) + (setq buf (dired (expand-file-name "dir*/*.txt" dir))) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files))))) + (delete-directory dir 'recursive) + (when (buffer-live-p buf) (kill-buffer buf))))) + + (provide 'dired-tests) ;; dired-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 0768e31f7e6..31f65413c88 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -219,5 +219,29 @@ (should (equal (cl--generic-1 '(5) nil) '("cinq" (5)))) (should (equal (cl--generic-1 '(6) nil) '("six" a)))) +(cl-defgeneric cl-generic-tests--generic (x)) +(cl-defmethod cl-generic-tests--generic ((x string)) + (message "%s is a string" x)) +(cl-defmethod cl-generic-tests--generic ((x integer)) + (message "%s is a number" x)) +(cl-defgeneric cl-generic-tests--generic-without-methods (x y)) +(defvar cl-generic-tests--this-file + (file-truename (or load-file-name buffer-file-name))) + +(ert-deftest cl-generic-tests--method-files--finds-methods () + "`method-files' returns a list of files and methods for a generic function." + (let ((retval (cl--generic-method-files 'cl-generic-tests--generic))) + (should (equal (length retval) 2)) + (mapc (lambda (x) + (should (equal (car x) cl-generic-tests--this-file)) + (should (equal (cadr x) 'cl-generic-tests--generic))) + retval) + (should-not (equal (nth 0 retval) (nth 1 retval))))) + +(ert-deftest cl-generic-tests--method-files--nonexistent-methods () + "`method-files' returns nil if asked to find a method which doesn't exist." + (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic)) + (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods))) + (provide 'cl-generic-tests) ;;; cl-generic-tests.el ends here diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 317838b250f..57463ad932d 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -352,7 +352,7 @@ This macro is used to test if macroexpansion in `should' works." (let ((abc (ert-get-test 'ert-test-abc))) (should (equal (ert-test-tags abc) '(bar))) (should (equal (ert-test-documentation abc) "foo"))) - (should (equal (symbol-file 'ert-test-deftest 'ert-deftest) + (should (equal (symbol-file 'ert-test-deftest 'ert--test) (symbol-file 'ert-test--which-file 'defun))) (ert-deftest ert-test-def () :expected-result ':passed) diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 8b7945c9d27..8f353b7e863 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -33,5 +33,15 @@ (number-sequence ?< ?\]) (number-sequence ?- ?:)))))) +(ert-deftest rx-pcase () + (should (equal (pcase "a 1 2 3 1 1 b" + ((rx (let u (+ digit)) space + (let v (+ digit)) space + (let v (+ digit)) space + (backref u) space + (backref 1)) + (list u v))) + '("1" "3")))) + (provide 'rx-tests) ;; rx-tests.el ends here. diff --git a/test/lisp/ls-lisp.el b/test/lisp/ls-lisp.el new file mode 100644 index 00000000000..5ef7c78f4df --- /dev/null +++ b/test/lisp/ls-lisp.el @@ -0,0 +1,37 @@ +;;; ls-lisp-tests.el --- tests for ls-lisp.el -*- lexical-binding: t-*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Tino Calacha <tino.calancha@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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + + +;;; Code: +(require 'ert) + +(ert-deftest ls-lisp-unload () + "Test for http://debbugs.gnu.org/xxxxx ." + (require 'ls-lisp) + (should (advice-member-p 'ls-lisp--insert-directory 'insert-directory)) + (unload-feature 'ls-lisp 'force) + (should-not (advice-member-p 'ls-lisp--insert-directory 'insert-directory))) + +(provide 'ls-lisp-tests) +;;; ls-lisp-tests.el ends here diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 94e91b79300..979f674f0f1 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -149,6 +149,7 @@ handled properly. BODY shall not contain a timeout." (debug-ignored-errors (cons "^make-symbolic-link not supported$" debug-ignored-errors)) inhibit-message) + (message "tramp--test-instrument-test-case %s" tramp-verbose) (unwind-protect (let ((tramp--test-instrument-test-case-p t)) ,@body) ;; Unwind forms. @@ -2201,6 +2202,108 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) +(ert-deftest tramp-test17-dired-with-wildcards () + "Check `dired' with wildcards." + (skip-unless (tramp--test-enabled)) + (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 + (expand-file-name (tramp--test-make-temp-name nil quoted))) + (tmp-name2 + (expand-file-name (tramp--test-make-temp-name nil quoted))) + (tmp-name3 (expand-file-name "foo" tmp-name1)) + (tmp-name4 (expand-file-name "bar" tmp-name2)) + (tramp-test-temporary-file-directory + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + tramp-test-temporary-file-directory)) + buffer) + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name3) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name3)) + (make-directory tmp-name2) + (write-region "foo" nil tmp-name4) + (should (file-directory-p tmp-name2)) + (should (file-exists-p tmp-name4)) + + ;; Check for expanded directory names. + (with-current-buffer + (setq buffer + (dired-noselect + (expand-file-name + "tramp-test*" tramp-test-temporary-file-directory))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name1 tramp-test-temporary-file-directory)))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name2 tramp-test-temporary-file-directory))))) + (kill-buffer buffer) + + ;; Check for expanded directory and file names. + (with-current-buffer + (setq buffer + (dired-noselect + (expand-file-name + "tramp-test*/*" tramp-test-temporary-file-directory))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name3 tramp-test-temporary-file-directory)))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name4 + tramp-test-temporary-file-directory))))) + (kill-buffer buffer) + + ;; Check for special characters. + (setq tmp-name3 (expand-file-name "*?" tmp-name1)) + (setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2)) + (write-region "foo" nil tmp-name3) + (should (file-exists-p tmp-name3)) + (write-region "foo" nil tmp-name4) + (should (file-exists-p tmp-name4)) + + (with-current-buffer + (setq buffer + (dired-noselect + (expand-file-name + "tramp-test*/*" tramp-test-temporary-file-directory))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name3 tramp-test-temporary-file-directory)))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name4 + tramp-test-temporary-file-directory))))) + (kill-buffer buffer)) + + ;; Cleanup. + (ignore-errors (kill-buffer buffer)) + (ignore-errors (delete-directory tmp-name1 'recursive)) + (ignore-errors (delete-directory tmp-name2 'recursive)))))) + (ert-deftest tramp-test18-file-attributes () "Check `file-attributes'. This tests also `file-readable-p', `file-regular-p' and @@ -3680,6 +3783,10 @@ Use the `ls' command." tramp-connection-properties))) (tramp--test-utf8))) +(defun tramp--test-timeout-handler () + (interactive) + (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) + ;; This test is inspired by Bug#16928. (ert-deftest tramp-test36-asynchronous-requests () "Check parallel asynchronous requests. @@ -3689,10 +3796,15 @@ process sentinels. They shall not disturb each other." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - ;; This test could be blocked on hydra. - (with-timeout - (300 (ert-fail "`tramp-test36-asynchronous-requests' timed out")) - (let* ((tmp-name (tramp--test-make-temp-name)) + ;; This test could be blocked on hydra. So we set a timeout of 300 + ;; seconds, and we send a SIGUSR1 signal after 300 seconds. + (with-timeout (300 (tramp--test-timeout-handler)) + (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler) + (let* ((watchdog + (start-process + "*watchdog*" nil shell-file-name shell-command-switch + (format "sleep 300; kill -USR1 %d" (emacs-pid)))) + (tmp-name (tramp--test-make-temp-name)) (default-directory tmp-name) ;; Do not cache Tramp properties. (remote-file-name-inhibit-cache t) @@ -3802,9 +3914,11 @@ process sentinels. They shall not disturb each other." (tramp--test-message "Trace 2 action %d %s %s" count buf (current-time-string)) (accept-process-output proc 0.1 nil 0) - ;; Regular operation. (tramp--test-message "Trace 3 action %d %s %s" count buf (current-time-string)) + ;; Give the watchdog a chance. + (read-event nil nil 0.01) + ;; Regular operation. (if (= count 2) (if (= (length buffers) 1) (tramp--test-instrument-test-case 10 @@ -3820,8 +3934,7 @@ process sentinels. They shall not disturb each other." ;; Checks. All process output shall exists in the ;; respective buffers. All created files shall be ;; deleted. - (tramp--test-message - "Check %s" (current-time-string)) + (tramp--test-message "Check %s" (current-time-string)) (dolist (buf buffers) (with-current-buffer buf (should (string-equal (format "%s\n" buf) (buffer-string))))) @@ -3830,6 +3943,8 @@ process sentinels. They shall not disturb each other." tmp-name nil directory-files-no-dot-files-regexp))) ;; Cleanup. + (define-key special-event-map [sigusr1] 'ignore) + (ignore-errors (quit-process watchdog)) (dolist (buf buffers) (ignore-errors (delete-process (get-buffer-process buf))) (ignore-errors (kill-buffer buf))) @@ -3906,6 +4021,14 @@ Since it unloads Tramp, it shall be the last test to run." (not (string-match "^tramp--?test" (symbol-name x))) (not (string-match "unload-hook$" (symbol-name x))) (ert-fail (format "`%s' still bound" x))))) + ;; The defstruct `tramp-file-name' and all its internal functions + ;; shall be purged. + (should-not (cl--find-class 'tramp-file-name)) + (mapatoms + (lambda (x) + (and (functionp x) + (string-match "tramp-file-name" (symbol-name x)) + (ert-fail (format "Structure function `%s' still exists" x))))) ;; There shouldn't be left a hook function containing a Tramp ;; function. We do not regard the Tramp unload hooks. (mapatoms diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el new file mode 100644 index 00000000000..0425bc0e0f4 --- /dev/null +++ b/test/lisp/register-tests.el @@ -0,0 +1,43 @@ +;;; register-tests.el --- tests for register.el -*- lexical-binding: t-*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Tino Calacha <tino.calancha@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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + + +;;; Code: +(require 'ert) +(require 'cl-lib) + +(ert-deftest register-test-bug27634 () + "Test for http://debbugs.gnu.org/27634 ." + (dolist (event (list ?\C-g 'escape ?\C-\[)) + (cl-letf (((symbol-function 'read-key) #'ignore) + (last-input-event event) + (register-alist nil)) + (should (equal 'quit + (condition-case err + (call-interactively 'point-to-register) + (quit (car err))))) + (should-not register-alist)))) + +(provide 'register-tests) +;;; register-tests.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 7e50429a5bf..a59f0ca90e1 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -292,31 +292,6 @@ cf. Bug#25477." (should-error (eval '(dolist "foo") t) :type 'wrong-type-argument)) -(require 'cl-generic) -(cl-defgeneric subr-tests--generic (x)) -(cl-defmethod subr-tests--generic ((x string)) - (message "%s is a string" x)) -(cl-defmethod subr-tests--generic ((x integer)) - (message "%s is a number" x)) -(cl-defgeneric subr-tests--generic-without-methods (x y)) -(defvar subr-tests--this-file - (file-truename (or load-file-name buffer-file-name))) - -(ert-deftest subr-tests--method-files--finds-methods () - "`method-files' returns a list of files and methods for a generic function." - (let ((retval (method-files 'subr-tests--generic))) - (should (equal (length retval) 2)) - (mapc (lambda (x) - (should (equal (car x) subr-tests--this-file)) - (should (equal (cadr x) 'subr-tests--generic))) - retval) - (should-not (equal (nth 0 retval) (nth 1 retval))))) - -(ert-deftest subr-tests--method-files--nonexistent-methods () - "`method-files' returns nil if asked to find a method which doesn't exist." - (should-not (method-files 'subr-tests--undefined-generic)) - (should-not (method-files 'subr-tests--generic-without-methods))) - (ert-deftest subr-tests-bug22027 () "Test for http://debbugs.gnu.org/22027 ." (let ((default "foo") res) diff --git a/test/manual/indent/perl.perl b/test/manual/indent/perl.perl index f86a09b2733..06f32e7f090 100755 --- a/test/manual/indent/perl.perl +++ b/test/manual/indent/perl.perl @@ -53,6 +53,14 @@ EOF1 bar EOF2 +print <<~"EOF1" . <<\EOF2 . s/he"llo/th'ere/; +foo +EOF2 + bar + EOF1 +bar +EOF2 + print $'; # This should not start a string! print "hello" for /./; diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index a0a317feeeb..dd5a2003b41 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -142,6 +142,23 @@ literals (Bug#20852)." "unescaped character literals " "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) +(ert-deftest lread-tests--funny-quote-symbols () + "Check that 'smart quotes' or similar trigger errors in symbol names." + (dolist (quote-char + '(#x2018 ;; LEFT SINGLE QUOTATION MARK + #x2019 ;; RIGHT SINGLE QUOTATION MARK + #x201B ;; SINGLE HIGH-REVERSED-9 QUOTATION MARK + #x201C ;; LEFT DOUBLE QUOTATION MARK + #x201D ;; RIGHT DOUBLE QUOTATION MARK + #x201F ;; DOUBLE HIGH-REVERSED-9 QUOTATION MARK + #x301E ;; DOUBLE PRIME QUOTATION MARK + #xFF02 ;; FULLWIDTH QUOTATION MARK + #xFF07 ;; FULLWIDTH APOSTROPHE + )) + (let ((str (format "%cfoo" quote-char))) + (should-error (read str) :type 'invalid-read-syntax) + (should (eq (read (concat "\\" str)) (intern str)))))) + (ert-deftest lread-test-bug26837 () "Test for http://debbugs.gnu.org/26837 ." (let ((load-path (cons |