Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

Browse source
This commit is contained in:
Michael R. Mauger 2017-08-06 20:58:08 -04:00
commit 6e2c0929ba
104 changed files with 2504 additions and 1276 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitlab-ci.yml
View file

@ -24,7 +24,7 @@
# Maintainer: tzz@lifelogs.com
# URL: https://gitlab.com/emacs-ci/emacs
image: debian:unstable
image: debian:stretch
before_script:
- apt update -qq

17
INSTALL
View file

@ -261,10 +261,10 @@ Emacs with the options '--without-dbus --without-gconf --without-gsettings'.
To read email via a network protocol like IMAP or POP, you can
configure Emacs with the option '--with-mailutils', so that it always
uses the GNU Mailutils 'movemail' program to retrieve mail. Otherwise
the Emacs build procedure builds and installs an auxiliary 'movemail'
program, a limited and insecure substitute that Emacs can use when
Mailutils is not installed; when this happens, there are several
uses the GNU Mailutils 'movemail' program to retrieve mail; this is
the default if GNU Mailutils is installed. Otherwise the Emacs build
procedure builds and installs an auxiliary 'movemail' program, a
limited and insecure substitute; when this happens, there are several
configure options such as --without-pop that provide fine-grained
control over Emacs 'movemail' construction.
@ -272,10 +272,9 @@ The Emacs mail reader RMAIL is configured to be able to read mail from
a POP3 server by default. Versions of the POP protocol older than
POP3 are not supported. While POP3 support is typically enabled,
whether Emacs actually uses POP3 is controlled by individual users;
see the Rmail chapter of the Emacs manual. Unless you configure
--with-mailutils, it is a good idea to configure --without-pop so that
users are less likely to inadvertently read email via insecure
channels.
see the Rmail chapter of the Emacs manual. Unless --with-mailutils is
in effect, it is a good idea to configure --without-pop so that users
are less likely to inadvertently read email via insecure channels.
For image support you may have to download, build, and install the
appropriate image support libraries for image types other than XBM and
@ -550,7 +549,7 @@ information on this.
Emacs info files.
8) If your system uses lock files to interlock access to mailer inbox files,
and if you did not configure --with-mailutils, then you might need to
and if --with-mailutils is not in effect, then you might need to
make the Emacs-specific 'movemail' program setuid or setgid in order
to enable it to write the lock files. We believe this is safe.

4
Makefile.in
View file

@ -448,7 +448,7 @@ config.status: ${srcdir}/configure
fi
$(srcdir)/configure: $(srcdir)/configure.ac $(srcdir)/m4/*.m4
cd $(srcdir) && ./autogen.sh
cd $(srcdir) && ./autogen.sh autoconf
# ==================== Installation ====================
@ -1094,7 +1094,7 @@ check-info: info
# * Rebuild Makefile, to update the build procedure itself.
# * Do the actual build.
bootstrap: bootstrap-clean
cd $(srcdir) && ./autogen.sh
cd $(srcdir) && ./autogen.sh autoconf
$(MAKE) MAKEFILE_NAME=force-Makefile force-Makefile
$(MAKE) all

3
admin/merge-gnulib
View file

@ -30,7 +30,8 @@ GNULIB_MODULES='
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
d-type 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

110
configure.ac
View file

@ -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
@ -233,9 +234,16 @@ AC_DEFUN([OPTION_DEFAULT_ON], [dnl
# in a movemail implementation that supports only unencrypted POP3
# connections. Encrypted connections should be the default.
OPTION_DEFAULT_OFF([mailutils],
[rely on GNU Mailutils, so that the --without-pop through --with-mailhost
options are irrelevant])
AC_ARG_WITH([mailutils],
[AS_HELP_STRING([--with-mailutils],
[rely on GNU Mailutils, so that the --without-pop through --with-mailhost
options are irrelevant; this is the default if GNU Mailutils is
installed])],
[],
[with_mailutils=$with_features
if test "$with_mailutils" = yes; then
(movemail --version) >/dev/null 2>&1 || with_mailutils=no
fi])
if test "$with_mailutils" = no; then
with_mailutils=
fi
@ -1222,8 +1230,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
@ -2832,89 +2840,6 @@ if test "${with_gnutls}" = "yes" ; then
[HAVE_GNUTLS=yes], [HAVE_GNUTLS=no])
if test "${HAVE_GNUTLS}" = "yes"; then
AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
EMACS_CHECK_MODULES([LIBGNUTLS3], [gnutls >= 3.0.0],
[AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.])], [])
AC_CACHE_CHECK([for GnuTLS v3 with HMAC], [emacs_cv_gnutls3_hmac],
[AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([[
#include <gnutls/gnutls.h>
#include <gnutls/crypto.h>
]], [[
int
main (void)
{
gnutls_hmac_hd_t handle;
gnutls_hmac_deinit (handle, NULL);
}
]])],
[emacs_cv_gnutls3_hmac=yes],
[emacs_cv_gnutls3_hmac=no])])
if test "$emacs_cv_gnutls3_hmac" = yes; then
AC_DEFINE([HAVE_GNUTLS3_HMAC], [1],
[Define if using GnuTLS v3 with HMAC support.])
fi
AC_CACHE_CHECK([for GnuTLS v3 with AEAD], [emacs_cv_gnutls3_aead],
[AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([[
#include <gnutls/gnutls.h>
#include <gnutls/crypto.h>
]], [[
int
main (void)
{
gnutls_aead_cipher_hd_t handle;
gnutls_aead_cipher_deinit (handle);
}
]])],
[emacs_cv_gnutls3_aead=yes],
[emacs_cv_gnutls3_aead=no])])
if test "$emacs_cv_gnutls3_aead" = yes; then
AC_DEFINE([HAVE_GNUTLS3_AEAD], [1],
[Define if using GnuTLS v3 with AEAD support.])
fi
AC_CACHE_CHECK([for GnuTLS v3 with cipher], [emacs_cv_gnutls3_cipher],
[AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([[
#include <gnutls/gnutls.h>
#include <gnutls/crypto.h>
]], [[
int
main (void)
{
gnutls_cipher_hd_t handle;
gnutls_cipher_encrypt2 (handle, NULL, 0, NULL, 0);
gnutls_cipher_deinit (handle);
}
]])],
[emacs_cv_gnutls3_cipher=yes],
[emacs_cv_gnutls3_cipher=no])])
if test "$emacs_cv_gnutls3_cipher" = yes; then
AC_DEFINE([HAVE_GNUTLS3_CIPHER], [1],
[Define if using GnuTLS v3 with cipher support.])
fi
AC_CACHE_CHECK([for GnuTLS v3 with digest], [emacs_cv_gnutls3_digest],
[AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([[
#include <gnutls/gnutls.h>
#include <gnutls/crypto.h>
]], [[
int
main (void)
{
gnutls_hash_hd_t handle;
gnutls_hash_deinit (handle, NULL);
}
]])],
[emacs_cv_gnutls3_digest=yes],
[emacs_cv_gnutls3_digest=no])])
if test "$emacs_cv_gnutls3_digest" = yes; then
AC_DEFINE([HAVE_GNUTLS3_DIGEST], [1],
[Define if using GnuTLS v3 with digest support.])
fi
fi
# Windows loads GnuTLS dynamically
@ -5509,13 +5434,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

28
doc/emacs/dired.texi
View file

@ -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.
@ -224,6 +236,14 @@ Dired cannot delete directories that are nonempty. If the variable
@code{dired-recursive-deletes} is non-@code{nil}, then Dired can
delete nonempty directories including all their contents. That can
be somewhat risky.
Even if you have set @code{dired-recursive-deletes} to @code{nil},
you might want sometimes to delete recursively directories
without being asked for confirmation for all of them. This is handy
when you have marked many directories for deletion and you are very
sure that all of them can safely being deleted. For every nonempty
directory you are asked for confirmation; if you answer @code{all},
then all the remaining directories will be deleted without more
questions.
@vindex delete-by-moving-to-trash
If you change the variable @code{delete-by-moving-to-trash} to

9
doc/emacs/help.texi
View file

@ -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

5
doc/emacs/regs.texi
View file

@ -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

2
doc/emacs/rmail.texi
View file

@ -1382,7 +1382,7 @@ Rmail attempts to locate the @command{movemail} program and determine its
version. There are two versions of the @command{movemail} program: the
GNU Mailutils version (@pxref{movemail,,,mailutils,GNU mailutils}),
and an Emacs-specific version that is built and installed unless Emacs
was configured using the @option{--with-mailutils} option.
was configured @option{--with-mailutils} in effect.
The two @command{mailtool} versions support the same
command line syntax and the same basic subset of options. However, the
Mailutils version offers additional features.

4
doc/emacs/search.texi
View file

@ -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)}

4
doc/lispref/display.texi
View file

@ -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

40
doc/lispref/loading.texi
View file

@ -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

30
etc/NEWS
View file

@ -31,10 +31,12 @@ Use 'configure --with-gnutls=no' to build even when GnuTLS is missing.
version 2.6.6 or later.
** The new option 'configure --with-mailutils' causes Emacs to rely on
GNU Mailutils 'movemail' to retrieve email. By default, the Emacs
build procedure continues to build and install a limited and insecure
'movemail' substitute. Although --with-mailutils is recommended, it
is not yet the default due to backward-compatibility concerns.
GNU Mailutils to retrieve email. It is recommended, and is the
default if GNU Mailutils is installed. When --with-mailutils is not
in effect, the Emacs build procedure by default continues to build and
install a limited 'movemail' substitute that retrieves POP3 email only
via insecure channels; to avoid this problem, use either
--with-mailutils or --without-pop when configuring.
** The new option 'configure --enable-gcc-warnings=warn-only' causes
GCC to issue warnings without stopping the build. This behavior is
@ -589,6 +591,12 @@ current buffer with the contents of the accessible portion of a
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
@ -598,8 +606,17 @@ paragraphs, for the purposes of bidirectional display.
* Changes in Specialized Modes and Packages in Emacs 26.1
** New function `cl-generic-p'.
** Dired
+++
*** You can answer 'all' in 'dired-do-delete' to delete recursively all
remaining directories without more prompts.
+++
*** 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.
@ -1076,6 +1093,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
@ -1167,6 +1187,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'.

16
etc/tutorials/TUTORIAL
View file

@ -17,15 +17,19 @@ The characters ">>" at the left margin indicate directions for you to
try using a command. For instance:
<<Blank lines inserted around following line by help-with-tutorial>>
[Middle of page left blank for didactic purposes. Text continues below]
>> Now type C-v (View next screen) to move to the next screen.
>> Now type C-v (View next screen) to scroll down in the tutorial.
(go ahead, do it by holding down the CONTROL key while typing v).
From now on, you should do this again whenever you finish
reading the screen.
From now on, please do this whenever you reach the end of the screen.
Note that there is an overlap of two lines when you move from screen
to screen; this provides some continuity so you can continue reading
Note that there is an overlap of two lines when you scroll a whole
screenful; this provides some continuity so you can continue reading
the text.
This is a copy of the Emacs tutorial text, customized slightly for
you. Later on we will instruct you to try various commands to alter
this text. Don't worry if you change this text before we tell you to;
that is called "editing" and that's what Emacs is for.
The first thing that you need to know is how to move around from place
to place in the text. You already know how to move forward one screen,
with C-v. To move backwards one screen, type M-v (hold down the META key
@ -33,6 +37,7 @@ and type v, or type <ESC>v if you do not have a META, EDIT, or ALT key).
>> Try typing M-v and then C-v, a few times.
It is ok to scroll this text in other ways, if you know how.
* SUMMARY
---------
@ -56,7 +61,6 @@ You can also use the PageUp and PageDn keys to move by screenfuls, if
your terminal has them, but you can edit more efficiently if you use
C-v and M-v.
* BASIC CURSOR CONTROL
----------------------

12
etc/tutorials/TUTORIAL.he
View file

@ -17,13 +17,18 @@
לדוגמה:
<<שורות ריקות תתווספנה סביב השורה הבאה ע״י help-with-tutorial>>
[אמצע העמוד הושאר ריק למטרות לימודיות. הטקסט ממשיך להלן]
>> הקישו עתה C-v (הצג העמוד הבא) על־מנת להתקדם לעמוד הבא. (קדימה, נסו
זאת ע״י לחיצה והחזקה של מקש CONTROL והקשה על v.)
>> הקישו עתה C-v (הצג העמוד הבא) על־מנת לגלול תצוגה לעמוד הבא. (קדימה,
נסו זאת ע״י לחיצה והחזקה של מקש CONTROL והקשה על v.)
מעתה והלאה, עליכם לעשות זאת בכל פעם שתסיימו לקרוא את המוצג על המסך.
שימו לב לחפיפה של שתי שורות כאשר אתם עוברים ממסך למשך, מה שמבטיח רציפות
שימו לב לחפיפה של שתי שורות כאשר אתם עוברים ממסך למסך, מה שמבטיח רציפות
מסוימת בעת קריאת הטקסט.
הטקסט שלפניכם הינו עותק של שיעור בשימוש ב־‫Emacs‬ שהותאם קלות עבורכם.
בהמשך תקבלו הוראות לנסות פקודות שונות כדי לבצע שינויים בטקסט הזה. אם
במקרה תשנו את הטקסט לפני שנבקש, אל דאגה: זוהי "עריכה" שהיא יעודו של
Emacs.
דבר ראשון שעליכם ללמוד הוא כיצד לנוע ממקום אחד למשנהו בתוך הטקסט. אתם
כבר יודעים כיצד להתקדם לעמוד הבא, עם C-v. לחזרה לעמוד הקודם הקישו M-v
(החזיקו מקש META והקישו v או הקישו ‪<ESC>v‬ אם אין במקלדת מקש META
@ -31,6 +36,7 @@
>> נסו עתה כמה פעמים להקיש M-v ואחר־כך C-v.
אפשר לגלול טקסט גם באמצעים אחרים, אם אתם יודעים כיצד לעשות זאת.
* סיכום עד כאן
--------------

4
lib/gnulib.mk.in
View file

@ -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 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
# 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 d-type 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
@ -546,8 +546,6 @@ LD_SWITCH_SYSTEM_TEMACS = @LD_SWITCH_SYSTEM_TEMACS@
LD_SWITCH_X_SITE = @LD_SWITCH_X_SITE@
LD_SWITCH_X_SITE_RPATH = @LD_SWITCH_X_SITE_RPATH@
LIBGIF = @LIBGIF@
LIBGNUTLS3_CFLAGS = @LIBGNUTLS3_CFLAGS@
LIBGNUTLS3_LIBS = @LIBGNUTLS3_LIBS@
LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
LIBGNU_LIBDEPS = @LIBGNU_LIBDEPS@

2
lib/tempname.c
View file

@ -279,7 +279,7 @@ try_nocreate (char *tmpl, void *flags _GL_UNUSED)
{
struct_stat64 st;
if (__lxstat64 (_STAT_VER, tmpl, &st) == 0)
if (__lxstat64 (_STAT_VER, tmpl, &st) == 0 || errno == EOVERFLOW)
__set_errno (EEXIST);
return errno == ENOENT ? 0 : -1;
}

42
lisp/apropos.el
View file

@ -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)

36
lisp/auth-source.el
View file

@ -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)

92
lisp/calendar/todo-mode.el
View file

@ -701,7 +701,8 @@ and done items are always shown on visiting a category."
;; We just initialized the first todo file, so make it the default.
(setq todo-default-todo-file (todo-short-file-name file)
first-file t)
(todo-reevaluate-default-file-defcustom))
(put 'todo-default-todo-file 'custom-type
`(radio ,@(todo--files-type-list))))
(unless (member file todo-visited)
;; Can't setq t-c-t-f here, otherwise wrong file shown when
;; todo-show is called from todo-show-categories-table.
@ -780,7 +781,8 @@ and done items are always shown on visiting a category."
(when first-file
(setq todo-default-todo-file nil
todo-current-todo-file nil)
(todo-reevaluate-default-file-defcustom))
(put 'todo-default-todo-file 'custom-type
`(radio ,@(todo--files-type-list))))
(kill-buffer)
(keyboard-quit)))))
(save-excursion (todo-category-select))
@ -1102,7 +1104,7 @@ Noninteractively, return the name of the new file."
(write-region (point-min) (point-max) file nil 'nomessage nil t)
(kill-buffer file))
(setq todo-files (funcall todo-files-function))
(todo-reevaluate-filelist-defcustoms)
(todo-update-filelist-defcustoms)
(if (called-interactively-p 'any)
(progn
(set-window-buffer (selected-window)
@ -1156,7 +1158,7 @@ these files, also rename them accordingly."
(setq todo-default-todo-file snname))
(when (string= todo-global-current-todo-file oname)
(setq todo-global-current-todo-file nname))
(todo-reevaluate-filelist-defcustoms)))
(todo-update-filelist-defcustoms)))
(defun todo-delete-file ()
"Delete the current todo, archive or filtered items file.
@ -1217,7 +1219,7 @@ visiting the deleted files."
(when (or (string= file1 todo-global-current-todo-file)
(and delete2 (string= file2 todo-global-current-todo-file)))
(setq todo-global-current-todo-file nil))
(todo-reevaluate-filelist-defcustoms)
(todo-update-filelist-defcustoms)
(message (concat (cond (todo "Todo") (archive "Archive")) " file \"%s\" "
(when delete2
(concat "and its "
@ -1387,7 +1389,7 @@ todo or done items."
(if (= (length todo-categories) 1)
;; If deleted category was the only one, delete the file.
(progn
(todo-reevaluate-filelist-defcustoms)
(todo-update-filelist-defcustoms)
;; Skip confirming killing the archive buffer if it has been
;; modified and not saved.
(set-buffer-modified-p nil)
@ -1430,7 +1432,7 @@ the archive of the file moved to, creating it if it does not exist."
(write-region (point-min) (point-max) nfile nil 'nomessage nil t)
(kill-buffer nfile))
(setq todo-files (funcall todo-files-function))
(todo-reevaluate-filelist-defcustoms))
(todo-update-filelist-defcustoms))
(dolist (buf buffers)
;; Make sure archive file is in Todo Archive mode so that
;; todo-categories has correct value.
@ -1524,7 +1526,7 @@ the archive of the file moved to, creating it if it does not exist."
(delete-file todo-current-todo-file)
(kill-buffer)
(when (member todo-current-todo-file todo-files)
(todo-reevaluate-filelist-defcustoms)))
(todo-update-filelist-defcustoms)))
(setq todo-categories (delete (assoc cat todo-categories)
todo-categories))
(todo-update-categories-sexp)
@ -4527,11 +4529,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)
@ -4801,7 +4801,7 @@ name in `todo-directory'. See also the documentation string of
(prin1 sexp (current-buffer)))
(write-region (point-min) (point-max) file nil 'nomessage))
(setq todo-archives (funcall todo-files-function t)))
(todo-reevaluate-filelist-defcustoms)
(todo-update-filelist-defcustoms)
(when (y-or-n-p (concat "Format conversion done; do you want to "
"visit the converted file now? "))
(setq todo-current-todo-file file)
@ -4865,7 +4865,7 @@ buffer, clean up the state and return nil."
(member todo-default-todo-file files))
(setq todo-default-todo-file (todo-short-file-name
(car todo-files))))
(todo-reevaluate-filelist-defcustoms)
(todo-update-filelist-defcustoms)
(when buf (kill-buffer buf))
nil)))))
@ -5751,7 +5751,8 @@ have been removed."
" been deleted and removed from\n"
"the list of category completion files")
names))
(todo-reevaluate-category-completions-files-defcustom)
(put 'todo-category-completions-files 'custom-type
`(set ,@(todo--files-type-list)))
(custom-set-default 'todo-category-completions-files
(symbol-value 'todo-category-completions-files))
(sleep-for 1.5)))
@ -6251,59 +6252,12 @@ the empty string (i.e., no time string)."
(hl-line-mode 1)
(hl-line-mode -1)))))))))
(defun todo-reevaluate-filelist-defcustoms ()
"Reevaluate defcustoms that provide choice list of todo files."
;; FIXME: This is hideous! I don't know enough about Custom to
;; offer something better, but please ask on emacs-devel!
(custom-set-default 'todo-default-todo-file
(symbol-value 'todo-default-todo-file))
(todo-reevaluate-default-file-defcustom)
(custom-set-default 'todo-filter-files (symbol-value 'todo-filter-files))
(todo-reevaluate-filter-files-defcustom)
(custom-set-default 'todo-category-completions-files
(symbol-value 'todo-category-completions-files))
(todo-reevaluate-category-completions-files-defcustom))
(defun todo-reevaluate-default-file-defcustom ()
"Reevaluate defcustom of `todo-default-todo-file'.
Called after adding or deleting a todo file. If the value of
`todo-default-todo-file' before calling this function was
associated with an existing file, keep that value."
;; FIXME: This is hideous! I don't know enough about Custom to
;; offer something better, but please ask on emacs-devel!
;; (let ((curval todo-default-todo-file))
(eval
(defcustom todo-default-todo-file (todo-short-file-name
(car (funcall todo-files-function)))
"Todo file visited by first session invocation of `todo-show'."
:type (when todo-files
`(radio ,@(todo--files-type-list)))
:group 'todo))
;; (when (and curval (file-exists-p (todo-absolute-file-name curval)))
;; (custom-set-default 'todo-default-todo-file curval)
;; ;; (custom-reevaluate-setting 'todo-default-todo-file)
;; )))
)
(defun todo-reevaluate-category-completions-files-defcustom ()
"Reevaluate defcustom of `todo-category-completions-files'.
Called after adding or deleting a todo file."
;; FIXME: This is hideous! I don't know enough about Custom to
;; offer something better, but please ask on emacs-devel!
(eval (defcustom todo-category-completions-files nil
"List of files for building `todo-read-category' completions."
:type `(set ,@(todo--files-type-list))
:group 'todo)))
(defun todo-reevaluate-filter-files-defcustom ()
"Reevaluate defcustom of `todo-filter-files'.
Called after adding or deleting a todo file."
;; FIXME: This is hideous! I don't know enough about Custom to
;; offer something better, but please ask on emacs-devel!
(eval (defcustom todo-filter-files nil
"List of files for multifile item filtering."
:type `(set ,@(todo--files-type-list))
:group 'todo)))
(defun todo-update-filelist-defcustoms ()
"Update defcustoms that provide choice list of todo files."
(put 'todo-default-todo-file 'custom-type `(radio ,@(todo--files-type-list)))
(put 'todo-category-completions-files 'custom-type
`(set ,@(todo--files-type-list)))
(put 'todo-filter-files 'custom-type `(set ,@(todo--files-type-list))))
;; -----------------------------------------------------------------------------
;;; Font locking

33
lisp/cedet/semantic/symref/grep.el
View file

@ -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)

10
lisp/dired-aux.el
View file

@ -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.
@ -619,8 +619,9 @@ with a prefix argument."
This function is used to add all related commands retrieved by `mailcap'
to the end of the list of defaults just after the default value."
(interactive)
(let ((commands (and (boundp 'files) (require 'mailcap nil t)
(mailcap-file-default-commands files))))
(let* ((files minibuffer-completion-table)
(commands (and (require 'mailcap nil t)
(mailcap-file-default-commands files))))
(if (listp minibuffer-default)
(append minibuffer-default commands)
(cons minibuffer-default commands))))
@ -638,6 +639,7 @@ This normally reads using `read-shell-command', but if the
offer a smarter default choice of shell command."
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-completion-table) files)
(set (make-local-variable 'minibuffer-default-add-function)
'minibuffer-default-add-dired-shell-commands))
(setq prompt (format prompt (dired-mark-prompt arg files)))
@ -742,8 +744,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))

9
lisp/dired-x.el
View file

@ -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

230
lisp/dired.el
View file

@ -34,6 +34,7 @@
;;; Code:
(eval-when-compile (require 'subr-x))
;; When bootstrapping dired-loaddefs has not been generated.
(require 'dired-loaddefs nil t)
@ -133,7 +134,7 @@ always set this variable to t."
:type 'boolean
:group 'dired-mark)
(defcustom dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#")
(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#")
"Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line.
A value of t means move to first file."
@ -871,6 +872,46 @@ periodically reverts at specified time intervals."
:group 'dired
:version "23.2")
(defun dired--need-align-p ()
"Return non-nil if some file names are misaligned.
The return value is the target column for the file names."
(save-excursion
(goto-char (point-min))
(dired-goto-next-file)
;; Use point difference instead of `current-column', because
;; the former works when `dired-hide-details-mode' is enabled.
(let* ((first (- (point) (point-at-bol)))
(target first))
(while (and (not (eobp))
(progn
(forward-line)
(dired-move-to-filename)))
(when-let* ((distance (- (point) (point-at-bol)))
(higher (> distance target)))
(setq target distance)))
(and (/= first target) target))))
(defun dired--align-all-files ()
"Align all files adding spaces in front of the size column."
(let ((target (dired--need-align-p))
(regexp directory-listing-before-filename-regexp))
(when target
(save-excursion
(goto-char (point-min))
(dired-goto-next-file)
(while (dired-move-to-filename)
;; Use point difference instead of `current-column', because
;; the former works when `dired-hide-details-mode' is enabled.
(let ((distance (- target (- (point) (point-at-bol))))
(inhibit-read-only t))
(unless (zerop distance)
(re-search-backward regexp nil t)
(goto-char (match-beginning 0))
(search-backward-regexp "[[:space:]]" nil t)
(skip-chars-forward "[:space:]")
(insert-char ?\s distance 'inherit))
(forward-line)))))))
(defun dired-internal-noselect (dir-or-list &optional switches mode)
;; If DIR-OR-LIST is a string and there is an existing dired buffer
;; for it, just leave buffer as it is (don't even call dired-revert).
@ -920,11 +961,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))
@ -939,6 +981,8 @@ periodically reverts at specified time intervals."
(if failed (kill-buffer buffer))))
(goto-char (point-min))
(dired-initial-position dirname))
(when (consp dired-directory)
(dired--align-all-files))
(set-buffer old-buf)
buffer))
@ -1056,13 +1100,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.
@ -1160,7 +1205,7 @@ BEG..END is the line where the file info is located."
(setq file-col (+ spaces file-col))
(if (> file-col other-col)
(setq spaces (- spaces (- file-col other-col))))
(insert-char ?\s spaces)
(insert-char ?\s spaces 'inherit)
;; Let's just make really sure we did not mess up.
(unless (save-excursion
(eq (dired-move-to-filename) (marker-position file)))
@ -1207,29 +1252,56 @@ 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))
;; We don't know whether the remote ls supports
;; "--dired", so we cannot add it to the `process-file'
;; call for wildcards.
(when (file-remote-p dir)
(setq switches (dired-replace-in-string "--dired" "" switches)))
(let* ((default-directory (car dir-wildcard))
(script (format "ls %s %s" switches (cdr dir-wildcard)))
(remotep (file-remote-p dir))
(sh (or (and remotep "/bin/sh")
(and (bound-and-true-p explicit-shell-file-name)
(executable-find explicit-shell-file-name))
(executable-find "sh")))
(switch (if remotep "-c" shell-command-switch)))
(unless
(zerop
(process-file sh nil (current-buffer) nil switch 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 +1351,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)
@ -1369,18 +1444,22 @@ ARG and NOCONFIRM, passed from `revert-buffer', are ignored."
The positions have the form (BUFFER-POSITION WINDOW-POSITIONS).
BUFFER-POSITION is the point position in the current Dired buffer.
It has the form (BUFFER DIRED-FILENAME BUFFER-POINT).
It has the form (BUFFER DIRED-FILENAME BUFFER-LINE-NUMBER).
WINDOW-POSITIONS are current positions in all windows displaying
this dired buffer. The window positions have the form (WINDOW
DIRED-FILENAME WINDOW-POINT)."
DIRED-FILENAME WINDOW-LINE-NUMBER).
We store line numbers instead of point positions because the header
lines might change as well: when this happen the line number doesn't
change; the point does."
(list
(list (current-buffer) (dired-get-filename nil t) (point))
(list (current-buffer) (dired-get-filename nil t) (line-number-at-pos))
(mapcar (lambda (w)
(list w
(with-selected-window w
(dired-get-filename nil t))
(window-point w)))
(with-selected-window w
(list w
(dired-get-filename nil t)
(line-number-at-pos (window-point w)))))
(get-buffer-window-list nil 0 t))))
(defun dired-restore-positions (positions)
@ -1389,7 +1468,8 @@ DIRED-FILENAME WINDOW-POINT)."
(buffer (nth 0 buf-file-pos)))
(unless (and (nth 1 buf-file-pos)
(dired-goto-file (nth 1 buf-file-pos)))
(goto-char (nth 2 buf-file-pos))
(goto-char (point-min))
(forward-line (1- (nth 2 buf-file-pos)))
(dired-move-to-filename))
(dolist (win-file-pos (nth 1 positions))
;; Ensure that window still displays the original buffer.
@ -1397,7 +1477,8 @@ DIRED-FILENAME WINDOW-POINT)."
(with-selected-window (nth 0 win-file-pos)
(unless (and (nth 1 win-file-pos)
(dired-goto-file (nth 1 win-file-pos)))
(goto-char (nth 2 win-file-pos))
(goto-char (point-min))
(forward-line (1- (nth 2 win-file-pos)))
(dired-move-to-filename)))))))
(defun dired-remember-marks (beg end)
@ -2900,6 +2981,14 @@ Any other value means to ask for each directory."
;; Match anything but `.' and `..'.
(defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
(defconst dired-delete-help
"Type:
`yes' to delete recursively the current directory,
`no' to skip to next,
`all' to delete all remaining directories with no more questions,
`quit' to exit,
`help' to show this help message.")
;; Delete file, possibly delete a directory and all its files.
;; This function is useful outside of dired. One could change its name
;; to e.g. recursive-delete-file and put it somewhere else.
@ -2915,23 +3004,45 @@ its possible values is:
TRASH non-nil means to trash the file instead of deleting, provided
`delete-by-moving-to-trash' (which see) is non-nil."
;; This test is equivalent to
;; (and (file-directory-p fn) (not (file-symlink-p fn)))
;; but more efficient
(if (not (eq t (car (file-attributes file))))
(delete-file file trash)
(if (and recursive
(directory-files file t dired-re-no-dot) ; Not empty.
(or (eq recursive 'always)
(yes-or-no-p (format "Recursively %s %s? "
(if (and trash
delete-by-moving-to-trash)
"trash"
"delete")
(dired-make-relative file)))))
(if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
(setq recursive nil))
(delete-directory file recursive trash)))
;; This test is equivalent to
;; (and (file-directory-p fn) (not (file-symlink-p fn)))
;; but more efficient
(if (not (eq t (car (file-attributes file))))
(delete-file file trash)
(let* ((valid-answers (list "yes" "no" "all" "quit" "help"))
(answer "")
(input-fn
(lambda ()
(setq answer
(read-string
(format "Recursively %s %s? [yes, no, all, quit, help] "
(if (and trash
delete-by-moving-to-trash)
"trash"
"delete")
(dired-make-relative file))))
(when (string= answer "help")
(with-help-window "*Help*"
(with-current-buffer "*Help*" (insert dired-delete-help))))
answer)))
(if (and recursive
(directory-files file t dired-re-no-dot) ; Not empty.
(eq recursive 'always))
(if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
;; Otherwise prompt user:
(funcall input-fn)
(while (not (member answer valid-answers))
(unless (string= answer "help")
(beep)
(message "Please answer `yes' or `no' or `all' or `quit'")
(sleep-for 2))
(funcall input-fn))
(pcase answer
('"all" (setq recursive 'always dired-recursive-deletes recursive))
('"yes" (if (eq recursive 'top) (setq recursive 'always)))
('"no" (setq recursive nil))
('"quit" (keyboard-quit))))
(delete-directory file recursive trash))))
(defun dired-do-flagged-delete (&optional nomessage)
"In Dired, delete the files flagged for deletion.
@ -2980,6 +3091,9 @@ non-empty directories is allowed."
(let* ((files (mapcar #'car l))
(count (length l))
(succ 0)
;; Bind `dired-recursive-deletes' so that we can change it
;; locally according with the user answer within `dired-delete-file'.
(dired-recursive-deletes dired-recursive-deletes)
(trashing (and trash delete-by-moving-to-trash)))
;; canonicalize file list for pop up
(setq files (nreverse (mapcar #'dired-make-relative files)))
@ -2989,6 +3103,7 @@ non-empty directories is allowed."
(if trashing "Trash" "Delete")
(dired-mark-prompt arg files)))
(save-excursion
(catch '--delete-cancel
(let ((progress-reporter
(make-progress-reporter
(if trashing "Trashing..." "Deleting...")
@ -3006,6 +3121,7 @@ non-empty directories is allowed."
(dired-fun-in-all-buffers
(file-name-directory fn) (file-name-nondirectory fn)
#'dired-delete-entry fn))
(quit (throw '--delete-cancel (message "OK, canceled")))
(error ;; catch errors from failed deletions
(dired-log "%s\n" err)
(setq failures (cons (car (car l)) failures)))))
@ -3016,7 +3132,7 @@ non-empty directories is allowed."
(format "%d of %d deletion%s failed"
(length failures) count
(dired-plural-s count))
failures))))
failures)))))
(message "(No deletions performed)")))
(dired-move-to-filename))

1
lisp/display-line-numbers.el
View file

@ -38,7 +38,6 @@
"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."

10
lisp/emacs-lisp/autoload.el
View file

@ -875,16 +875,16 @@ FILE's modification time."
"Save current buffer to its file, atomically."
;; Copied from byte-compile-file.
(let* ((version-control 'never)
(tempfile (make-temp-name buffer-file-name))
(tempfile (make-temp-file buffer-file-name))
(kill-emacs-hook
(cons (lambda () (ignore-errors (delete-file tempfile)))
kill-emacs-hook)))
(write-region (point-min) (point-max) tempfile nil 1)
(backup-buffer)
(rename-file tempfile buffer-file-name t)
(set-buffer-modified-p nil)
(set-visited-file-modtime)
(or noninteractive (message "Wrote %s" buffer-file-name))))
(rename-file tempfile buffer-file-name t))
(set-buffer-modified-p nil)
(set-visited-file-modtime)
(or noninteractive (message "Wrote %s" buffer-file-name)))
(defun autoload-save-buffers ()
(while autoload-modified-buffers

17
lisp/emacs-lisp/avl-tree.el
View file

@ -52,7 +52,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'generator)
;; ================================================================
@ -670,6 +670,21 @@ a null element stored in the AVL tree.)"
(null (avl-tree--stack-store avl-tree-stack)))
(iter-defun avl-tree-iter (tree &optional reverse)
"Return an AVL tree iterator object.
Calling `iter-next' on this object will retrieve the next element
from TREE. If REVERSE is non-nil, elements are returned in
reverse order.
Note that any modification to TREE *immediately* invalidates all
iterators created from TREE before the modification (in
particular, calling `iter-next' will give unpredictable results)."
(let ((stack (avl-tree-stack tree reverse)))
(while (not (avl-tree-stack-empty-p stack))
(iter-yield (avl-tree-stack-pop stack)))))
(provide 'avl-tree)
;;; avl-tree.el ends here

40
lisp/emacs-lisp/bytecomp.el
View file

@ -1888,25 +1888,27 @@ The value is non-nil if there were no errors, nil if errors."
(insert "\n") ; aaah, unix.
(if (file-writable-p target-file)
;; We must disable any code conversion here.
(let* ((coding-system-for-write 'no-conversion)
;; Write to a tempfile so that if another Emacs
;; process is trying to load target-file (eg in a
;; parallel bootstrap), it does not risk getting a
;; half-finished file. (Bug#4196)
(tempfile (make-temp-name target-file))
(kill-emacs-hook
(cons (lambda () (ignore-errors (delete-file tempfile)))
kill-emacs-hook)))
(write-region (point-min) (point-max) tempfile nil 1)
;; This has the intentional side effect that any
;; hard-links to target-file continue to
;; point to the old file (this makes it possible
;; for installed files to share disk space with
;; the build tree, without causing problems when
;; emacs-lisp files in the build tree are
;; recompiled). Previously this was accomplished by
;; deleting target-file before writing it.
(rename-file tempfile target-file t)
(progn
(let* ((coding-system-for-write 'no-conversion)
;; Write to a tempfile so that if another Emacs
;; process is trying to load target-file (eg in a
;; parallel bootstrap), it does not risk getting a
;; half-finished file. (Bug#4196)
(tempfile (make-temp-file target-file))
(kill-emacs-hook
(cons (lambda () (ignore-errors
(delete-file tempfile)))
kill-emacs-hook)))
(write-region (point-min) (point-max) tempfile nil 1)
;; This has the intentional side effect that any
;; hard-links to target-file continue to
;; point to the old file (this makes it possible
;; for installed files to share disk space with
;; the build tree, without causing problems when
;; emacs-lisp files in the build tree are
;; recompiled). Previously this was accomplished by
;; deleting target-file before writing it.
(rename-file tempfile target-file t))
(or noninteractive (message "Wrote %s" target-file)))
;; This is just to give a better error message than write-region
(let ((exists (file-exists-p target-file)))

55
lisp/emacs-lisp/cl-generic.el
View file

@ -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))
@ -409,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)]
@ -500,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))
@ -1022,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

4
lisp/emacs-lisp/edebug.el
View file

@ -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))

3
lisp/emacs-lisp/eieio-compat.el
View file

@ -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)

5
lisp/emacs-lisp/elp.el
View file

@ -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)

14
lisp/emacs-lisp/ert.el
View file

@ -135,16 +135,9 @@ 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)
;; Register in load-history, so `symbol-file' can find us, and so
;; unload-feature can unload our tests.
(cl-pushnew `(ert-deftest . ,symbol) current-load-list :test #'equal)
(define-symbol-prop symbol 'ert--test definition)
definition)
(cl-defmethod loadhist-unload-element ((x (head ert-deftest)))
(let ((name (cdr x)))
(put name 'ert--test nil)))
(defun ert-make-test-unbound (symbol)
"Make SYMBOL name no test. Return SYMBOL."
(cl-remprop symbol 'ert--test)
@ -2406,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))
@ -2540,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)))

4
lisp/emacs-lisp/pcase.el
View file

@ -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."

4
lisp/emacs-lisp/re-builder.el
View file

@ -64,8 +64,8 @@
;; syntax and string syntax are both delimited by `"'s and behave
;; according to their name. With the `string' syntax there's no need
;; to escape the backslashes and double quotes simplifying the editing
;; somewhat. The other three allow editing of symbolic regular
;; expressions supported by the packages of the same name.
;; somewhat. The `rx' syntax allows editing of symbolic regular
;; expressions supported by the package of the same name.
;; Editing symbolic expressions is done through a major mode derived
;; from `emacs-lisp-mode' so you'll get all the good stuff like

4
lisp/emacs-lisp/tabulated-list.el
View file

@ -194,6 +194,8 @@ Populated by `tabulated-list-init-header'.")
mouse-face highlight
keymap ,tabulated-list-sort-button-map))
(cols nil))
(if display-line-numbers
(setq x (+ x (line-number-display-width) 2)))
(push (propertize " " 'display `(space :align-to ,x)) cols)
(dotimes (n (length tabulated-list-format))
(let* ((col (aref tabulated-list-format n))
@ -410,6 +412,8 @@ of column descriptors."
(x (max tabulated-list-padding 0))
(ncols (length tabulated-list-format))
(inhibit-read-only t))
(if display-line-numbers
(setq x (+ x (line-number-display-width) 2)))
(if (> tabulated-list-padding 0)
(insert (make-string x ?\s)))
(let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).

78
lisp/eshell/em-ls.el
View file

@ -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
@ -241,6 +243,9 @@ scope during the evaluation of TEST-SEXP."
;;; Functions:
(declare-function eshell-extended-glob "em-glob" (glob))
(defvar eshell-error-if-no-glob)
(defun eshell-ls--insert-directory
(orig-fun file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
@ -273,11 +278,53 @@ instead."
(set 'font-lock-buffers
(delq (current-buffer)
(symbol-value 'font-lock-buffers)))))
(let ((insert-func 'insert)
(error-func 'insert)
(flush-func 'ignore)
eshell-ls-dired-initial-args)
(eshell-do-ls (append switches (list file)))))))))
(require 'em-glob)
(let* ((insert-func 'insert)
(error-func 'insert)
(flush-func 'ignore)
(eshell-error-if-no-glob t)
(target ; Expand the shell wildcards if any.
(if (and (atom file)
(string-match "[[?*]" file)
(not (file-exists-p file)))
(mapcar #'file-relative-name (eshell-extended-glob file))
(file-relative-name file)))
(switches
(append eshell-ls-dired-initial-args
(and (or (consp dired-directory) wildcard) (list "-d"))
switches)))
(eshell-do-ls (nconc switches (list target)))))))))
(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'."
@ -909,6 +956,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:

6
lisp/faces.el
View file

@ -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.
@ -1452,7 +1454,7 @@ If FRAME is omitted or nil, use the selected frame."
(setq face (list face)))
(with-help-window (help-buffer)
(with-current-buffer standard-output
(dolist (f face)
(dolist (f face (buffer-string))
(if (stringp f) (setq f (intern f)))
;; We may get called for anonymous faces (i.e., faces
;; expressed using prop-value plists). Those can't be

159
lisp/files.el
View file

@ -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.
@ -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,19 +6683,25 @@ 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.
(call-process
shell-file-name nil t nil
"-c"
shell-command-switch
(concat (if (memq system-type '(ms-dos windows-nt))
""
"\\") ; Disregard Unix shell aliases!
@ -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

2
lisp/find-dired.el
View file

@ -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.

2
lisp/find-lisp.el
View file

@ -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

4
lisp/frame.el
View file

@ -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)

2
lisp/gnus/mm-uu.el
View file

@ -393,7 +393,7 @@ apply the face `mm-uu-extract'."
(defun mm-uu-org-src-code-block-extract ()
(mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
'("text/x-org")))
'("text/x-org" (charset . gnus-decoded))))
(defvar gnus-newsgroup-name)

4
lisp/help-mode.el
View file

@ -393,12 +393,12 @@ it does not already exist."
(defvar describe-symbol-backends
`((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s)))
("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))
(nil
,(lambda (symbol)
(or (and (boundp symbol) (not (keywordp symbol)))
(get symbol 'variable-documentation)))
,#'describe-variable)))
,#'describe-variable)
("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))))
;;;###autoload
(defun help-make-xrefs (&optional buffer)

2
lisp/ido.el
View file

@ -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.

6
lisp/info.el
View file

@ -171,7 +171,11 @@ A header-line does not scroll with the rest of the buffer."
;; defvar and explicitly give it a standard-value property, and
;; call custom-initialize-delay on it.
;; The progn forces the autoloader to include the whole thing, not
;; just an abbreviated version.
;; just an abbreviated version. The value is initialized at startup
;; time, when command-line calls custom-reevaluate-setting on all
;; the defcustoms in custom-delayed-init-variables. This is
;; somewhat sub-optimal, as ideally this should be done when Info
;; mode is first invoked.
;;;###autoload
(progn
(defcustom Info-default-directory-list

4
lisp/international/mule-conf.el
View file

@ -1175,7 +1175,8 @@
:short-name "CNS11643-15"
:long-name "CNS11643-15 (Chinese traditional)"
:code-space [33 126 33 126]
:code-offset #x27A000)
:code-offset #x27A000
:unify-map "CNS-F")
(unify-charset 'chinese-gb2312)
(unify-charset 'chinese-gbk)
@ -1186,6 +1187,7 @@
(unify-charset 'chinese-cns11643-5)
(unify-charset 'chinese-cns11643-6)
(unify-charset 'chinese-cns11643-7)
(unify-charset 'chinese-cns11643-15)
(unify-charset 'big5)
(unify-charset 'chinese-big5-1)
(unify-charset 'chinese-big5-2)

2
lisp/kmacro.el
View file

@ -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.

425
lisp/ldefs-boot.el
View file

@ -1102,6 +1102,15 @@ options only, i.e. behave like `apropos-user-option'.
\(fn PATTERN &optional DO-NOT-ALL)" t nil)
(autoload 'apropos-local-variable "apropos" "\
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.
\(fn PATTERN &optional BUFFER)" t nil)
(defalias 'command-apropos 'apropos-command)
(autoload 'apropos-command "apropos" "\
@ -1167,6 +1176,13 @@ Returns list of symbols and values found.
\(fn PATTERN &optional DO-ALL)" t nil)
(autoload 'apropos-local-value "apropos" "\
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.
\(fn PATTERN &optional BUFFER)" t nil)
(autoload 'apropos-documentation "apropos" "\
Show symbols whose documentation contains matches for PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
@ -2878,6 +2894,8 @@ columns on its right towards the left.
(put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format)))))
(put 'bug-reference-bug-regexp 'safe-local-variable 'stringp)
(autoload 'bug-reference-mode "bug-reference" "\
Toggle hyperlinking bug references in the buffer (Bug Reference mode).
With a prefix argument ARG, enable Bug Reference mode if ARG is
@ -7682,6 +7700,46 @@ in `.emacs'.
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "disp-table" '("display-table-print-array")))
;;;***
;;;### (autoloads nil "display-line-numbers" "display-line-numbers.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from display-line-numbers.el
(autoload 'display-line-numbers-mode "display-line-numbers" "\
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.
\(fn &optional ARG)" t nil)
(defvar global-display-line-numbers-mode nil "\
Non-nil if Global Display-Line-Numbers mode is enabled.
See the `global-display-line-numbers-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-display-line-numbers-mode'.")
(custom-autoload 'global-display-line-numbers-mode "display-line-numbers" nil)
(autoload 'global-display-line-numbers-mode "display-line-numbers" "\
Toggle Display-Line-Numbers mode in all buffers.
With prefix ARG, enable Global Display-Line-Numbers mode if ARG is positive;
otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
Display-Line-Numbers mode is enabled in all buffers where
`display-line-numbers--turn-on' would do it.
See `display-line-numbers-mode' for more information on Display-Line-Numbers mode.
\(fn &optional ARG)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "display-line-numbers" '("display-line-numbers-")))
;;;***
;;;### (autoloads nil "dissociate" "play/dissociate.el" (0 0 0 0))
@ -11892,9 +11950,12 @@ Render FILE using EWW.
(autoload 'eww-search-words "eww" "\
Search the web for the text between BEG and END.
See the `eww-search-prefix' variable for the search engine used.
If region is active (and not whitespace), search the web for
the text between BEG and END. Else, prompt the user for a search
string. See the `eww-search-prefix' variable for the search
engine used.
\(fn &optional BEG END)" t nil)
\(fn)" t nil)
(autoload 'eww-mode "eww" "\
Mode for browsing the web.
@ -11935,7 +11996,7 @@ command to find the next error. The buffer is also in `comint-mode' and
(autoload 'executable-set-magic "executable" "\
Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
The variables `executable-magicless-file-regexp', `executable-prefix',
The variables `executable-magicless-file-regexp', `executable-prefix-env',
`executable-insert', `executable-query' and `executable-chmod' control
when and how magic numbers are inserted or replaced and scripts made
executable.
@ -12316,7 +12377,8 @@ If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
With a prefix, this command behaves exactly like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
and the functions `ffap-file-at-point' and `ffap-url-at-point'.
`ffap-url-unwrap-local', `ffap-url-unwrap-remote', and the functions
`ffap-file-at-point' and `ffap-url-at-point'.
\(fn &optional FILENAME)" t nil)
@ -14998,8 +15060,12 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').")
(custom-autoload 'grep-setup-hook "grep" t)
(defconst grep-regexp-alist '(("^\\(.*?[^/\n]\\):[ ]*\\([1-9][0-9]*\\)[ ]*:" 1 2 ((lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\
Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
(autoload 'grep-regexp-alist "grep" "\
Return a regexp alist to match grep hits.
The regexp used depends on `grep-use-null-filename-separator'.
See `compilation-error-regexp-alist' for format details.
\(fn)" nil nil)
(defvar grep-program (purecopy "grep") "\
The default grep program for `grep-command' and `grep-find-command'.
@ -19147,7 +19213,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.
\(fn ARG)" t nil)
@ -19175,8 +19242,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].
\(fn ARG &optional NO-REPEAT END-MACRO MACRO)" t nil)
@ -19211,8 +19278,8 @@ Call last keyboard macro, ending it first if currently being defined.
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].
\(fn ARG &optional NO-REPEAT)" t nil)
@ -19522,7 +19589,7 @@ something strange, such as redefining an Emacs function.
\(fn FEATURE &optional FORCE)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "loadhist" '("unload-" "loadhist-hook-functions" "read-feature" "feature-" "file-")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "loadhist" '("loadhist-" "unload-" "read-feature" "feature-" "file-")))
;;;***
@ -20360,7 +20427,7 @@ Default bookmark handler for Man buffers.
;;;### (autoloads nil "map" "emacs-lisp/map.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/map.el
(push (purecopy '(map 1 1)) package--builtin-versions)
(push (purecopy '(map 1 2)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "map" '("map")))
@ -22708,12 +22775,27 @@ Many aspects this mode can be customized using
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-C" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-J" "org/ob-J.el" (0 0 0 0))
;;; Generated autoloads from org/ob-J.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-J" '("obj-" "org-babel-")))
;;;***
;;;### (autoloads nil "ob-R" "org/ob-R.el" (0 0 0 0))
;;; Generated autoloads from org/ob-R.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("org-babel-")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("ob-R-" "org-babel-")))
;;;***
;;;### (autoloads nil "ob-abc" "org/ob-abc.el" (0 0 0 0))
;;; Generated autoloads from org/ob-abc.el
(push (purecopy '(ob-abc 0 1)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-abc" '("org-babel-")))
;;;***
@ -22751,6 +22833,13 @@ Many aspects this mode can be customized using
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-comint" '("org-babel-comint-")))
;;;***
;;;### (autoloads nil "ob-coq" "org/ob-coq.el" (0 0 0 0))
;;; Generated autoloads from org/ob-coq.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-coq" '("org-babel-" "coq-program-name")))
;;;***
;;;### (autoloads "actual autoloads are elsewhere" "ob-core" "org/ob-core.el"
@ -22780,6 +22869,14 @@ Many aspects this mode can be customized using
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-dot" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-ebnf" "org/ob-ebnf.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ebnf.el
(push (purecopy '(ob-ebnf 1 0)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ebnf" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-emacs-lisp" "org/ob-emacs-lisp.el" (0 0
@ -22802,6 +22899,13 @@ Many aspects this mode can be customized using
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-exp" '("org-")))
;;;***
;;;### (autoloads nil "ob-forth" "org/ob-forth.el" (0 0 0 0))
;;; Generated autoloads from org/ob-forth.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-forth" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-fortran" "org/ob-fortran.el" (0 0 0 0))
@ -22816,6 +22920,13 @@ Many aspects this mode can be customized using
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-gnuplot" '("org-babel-" "*org-babel-gnuplot-")))
;;;***
;;;### (autoloads nil "ob-groovy" "org/ob-groovy.el" (0 0 0 0))
;;; Generated autoloads from org/ob-groovy.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-groovy" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-haskell" "org/ob-haskell.el" (0 0 0 0))
@ -22857,7 +22968,7 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-latex" "org/ob-latex.el" (0 0 0 0))
;;; Generated autoloads from org/ob-latex.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-" "convert-pdf")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-")))
;;;***
@ -22888,6 +22999,13 @@ Many aspects this mode can be customized using
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lob" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-lua" "org/ob-lua.el" (0 0 0 0))
;;; Generated autoloads from org/ob-lua.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lua" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-makefile" "org/ob-makefile.el" (0 0 0 0))
@ -22951,6 +23069,14 @@ Many aspects this mode can be customized using
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-plantuml" '("org-")))
;;;***
;;;### (autoloads nil "ob-processing" "org/ob-processing.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from org/ob-processing.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-processing" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-python" "org/ob-python.el" (0 0 0 0))
@ -23002,10 +23128,18 @@ Many aspects this mode can be customized using
;;;***
;;;### (autoloads nil "ob-sh" "org/ob-sh.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sh.el
;;;### (autoloads nil "ob-sed" "org/ob-sed.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sed.el
(push (purecopy '(ob-sed 0 1 0)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sh" '("org-babel-")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sed" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-shell" "org/ob-shell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-shell.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shell" '("org-babel-")))
;;;***
@ -23019,7 +23153,7 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-sql" "org/ob-sql.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sql.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-" "dbstring-mysql")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-")))
;;;***
@ -23028,6 +23162,13 @@ Many aspects this mode can be customized using
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sqlite" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-stan" "org/ob-stan.el" (0 0 0 0))
;;; Generated autoloads from org/ob-stan.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-stan" '("org-babel-")))
;;;***
;;;### (autoloads nil "ob-table" "org/ob-table.el" (0 0 0 0))
@ -23137,7 +23278,7 @@ Load the languages defined in `org-babel-load-languages'.
\(fn SYM VALUE)" nil nil)
(autoload 'org-babel-load-file "org" "\
Load Emacs Lisp source code blocks in the Org-mode FILE.
Load Emacs Lisp source code blocks in the Org FILE.
This function exports the source code using `org-babel-tangle'
and then loads the resulting file using `load-file'. With prefix
arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
@ -23146,10 +23287,11 @@ file to byte-code before it is loaded.
\(fn FILE &optional COMPILE)" t nil)
(autoload 'org-version "org" "\
Show the org-mode version in the echo area.
With prefix argument HERE, insert it at point.
When FULL is non-nil, use a verbose version string.
When MESSAGE is non-nil, display a message with the version.
Show the Org version.
Interactively, or when MESSAGE is non-nil, show it in echo area.
With prefix argument, or when HERE is non-nil, insert it at point.
In non-interactive uses, a reduced version string is output unless
FULL is given.
\(fn &optional HERE FULL MESSAGE)" t nil)
@ -23167,15 +23309,15 @@ Set up hooks for clock persistence.
Outline-based notes management and organizer, alias
\"Carsten's outline-mode for keeping track of everything.\"
Org-mode develops organizational tasks around a NOTES file which
contains information about projects as plain text. Org-mode is
implemented on top of outline-mode, which is ideal to keep the content
Org mode develops organizational tasks around a NOTES file which
contains information about projects as plain text. Org mode is
implemented on top of Outline mode, which is ideal to keep the content
of large files well structured. It supports ToDo items, deadlines and
time stamps, which magically appear in the diary listing of the Emacs
calendar. Tables are easily created with a built-in table editor.
Plain text URL-like links connect to websites, emails (VM), Usenet
messages (Gnus), BBDB entries, and any files related to the project.
For printing and sharing of notes, an Org-mode file (or a part of it)
For printing and sharing of notes, an Org file (or a part of it)
can be exported as a structured ASCII or HTML file.
The following commands are available:
@ -23185,58 +23327,60 @@ The following commands are available:
\(fn)" t nil)
(autoload 'org-cycle "org" "\
TAB-action and visibility cycling for Org-mode.
TAB-action and visibility cycling for Org mode.
This is the command invoked in Org-mode by the TAB key. Its main purpose
is outline visibility cycling, but it also invokes other actions
This is the command invoked in Org mode by the `TAB' key. Its main
purpose is outline visibility cycling, but it also invokes other actions
in special contexts.
- When this function is called with a prefix argument, rotate the entire
buffer through 3 states (global cycling)
When this function is called with a `\\[universal-argument]' prefix, rotate the entire
buffer through 3 states (global cycling)
1. OVERVIEW: Show only top-level headlines.
2. CONTENTS: Show all headlines of all levels, but no body text.
3. SHOW ALL: Show everything.
When called with two `C-u C-u' prefixes, switch to the startup visibility,
determined by the variable `org-startup-folded', and by any VISIBILITY
properties in the buffer.
When called with three `C-u C-u C-u' prefixed, show the entire buffer,
including any drawers.
- When inside a table, re-align the table and move to the next field.
With a `\\[universal-argument] \\[universal-argument]' prefix argument, switch to the startup visibility,
determined by the variable `org-startup-folded', and by any VISIBILITY
properties in the buffer.
- When point is at the beginning of a headline, rotate the subtree started
by this line through 3 different states (local cycling)
With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix argument, show the entire buffer, including
any drawers.
When inside a table, re-align the table and move to the next field.
When point is at the beginning of a headline, rotate the subtree started
by this line through 3 different states (local cycling)
1. FOLDED: Only the main headline is shown.
2. CHILDREN: The main headline and the direct children are shown.
From this state, you can move to one of the children
and zoom in further.
3. SUBTREE: Show the entire subtree, including body text.
If there is no subtree, switch directly from CHILDREN to FOLDED.
If there is no subtree, switch directly from CHILDREN to FOLDED.
- When point is at the beginning of an empty headline and the variable
`org-cycle-level-after-item/entry-creation' is set, cycle the level
of the headline by demoting and promoting it to likely levels. This
speeds up creation document structure by pressing TAB once or several
times right after creating a new headline.
When point is at the beginning of an empty headline and the variable
`org-cycle-level-after-item/entry-creation' is set, cycle the level
of the headline by demoting and promoting it to likely levels. This
speeds up creation document structure by pressing `TAB' once or several
times right after creating a new headline.
- When there is a numeric prefix, go up to a heading with level ARG, do
a `show-subtree' and return to the previous cursor position. If ARG
is negative, go up that many levels.
When there is a numeric prefix, go up to a heading with level ARG, do
a `show-subtree' and return to the previous cursor position. If ARG
is negative, go up that many levels.
- When point is not at the beginning of a headline, execute the global
binding for TAB, which is re-indenting the line. See the option
`org-cycle-emulate-tab' for details.
When point is not at the beginning of a headline, execute the global
binding for `TAB', which is re-indenting the line. See the option
`org-cycle-emulate-tab' for details.
- Special case: if point is at the beginning of the buffer and there is
no headline in line 1, this function will act as if called with prefix arg
(C-u TAB, same as S-TAB) also when called without prefix arg.
But only if also the variable `org-cycle-global-at-bob' is t.
As a special case, if point is at the beginning of the buffer and there is
no headline in line 1, this function will act as if called with prefix arg
\(`\\[universal-argument] TAB', same as `S-TAB') also when called without prefix arg, but only
if the variable `org-cycle-global-at-bob' is t.
\(fn &optional ARG)" t nil)
(autoload 'org-global-cycle "org" "\
Cycle the global visibility. For details see `org-cycle'.
With \\[universal-argument] prefix arg, switch to startup visibility.
With `\\[universal-argument]' prefix ARG, switch to startup visibility.
With a numeric prefix, show all headlines up to that level.
\(fn &optional ARG)" t nil)
@ -23244,10 +23388,10 @@ With a numeric prefix, show all headlines up to that level.
(autoload 'orgstruct-mode "org" "\
Toggle the minor mode `orgstruct-mode'.
This mode is for using Org-mode structure commands in other
modes. The following keys behave as if Org-mode were active, if
This mode is for using Org mode structure commands in other
modes. The following keys behave as if Org mode were active, if
the cursor is on a headline, or on a plain list item (both as
defined by Org-mode).
defined by Org mode).
\(fn &optional ARG)" t nil)
@ -23262,62 +23406,60 @@ Unconditionally turn on `orgstruct++-mode'.
\(fn)" nil nil)
(autoload 'org-run-like-in-org-mode "org" "\
Run a command, pretending that the current buffer is in Org-mode.
Run a command, pretending that the current buffer is in Org mode.
This will temporarily bind local variables that are typically bound in
Org-mode to the values they have in Org-mode, and then interactively
Org mode to the values they have in Org mode, and then interactively
call CMD.
\(fn CMD)" nil nil)
(autoload 'org-store-link "org" "\
\\<org-mode-map>Store an org-link to the current location.
Store an org-link to the current location.
\\<org-mode-map>
This link is added to `org-stored-links' and can later be inserted
into an org-buffer with \\[org-insert-link].
into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
For some link types, a prefix arg is interpreted.
For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
For file links, arg negates `org-context-in-file-links'.
For some link types, a `\\[universal-argument]' prefix ARG is interpreted. A single
`\\[universal-argument]' negates `org-context-in-file-links' for file links or
`org-gnus-prefer-web-links' for links to Usenet articles.
A double prefix arg force skipping storing functions that are not
part of Org's core.
A `\\[universal-argument] \\[universal-argument]' prefix ARG forces skipping storing functions that are not
part of Org core.
A triple prefix arg force storing a link for each line in the
A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix ARG forces storing a link for each line in the
active region.
\(fn ARG)" t nil)
(autoload 'org-insert-link-global "org" "\
Insert a link like Org-mode does.
This command can be called in any mode to insert a link in Org-mode syntax.
Insert a link like Org mode does.
This command can be called in any mode to insert a link in Org syntax.
\(fn)" t nil)
(autoload 'org-open-at-point-global "org" "\
Follow a link like Org-mode does.
This command can be called in any mode to follow a link that has
Org-mode syntax.
Follow a link or time-stamp like Org mode does.
This command can be called in any mode to follow an external link
or a time-stamp that has Org mode syntax. Its behavior is
undefined when called on internal links (e.g., fuzzy links).
Raise an error when there is nothing to follow.
\(fn)" t nil)
(autoload 'org-open-link-from-string "org" "\
Open a link in the string S, as if it was in Org-mode.
Open a link in the string S, as if it was in Org mode.
\(fn S &optional ARG REFERENCE-BUFFER)" t nil)
(autoload 'org-switchb "org" "\
Switch between Org buffers.
With one prefix argument, restrict available buffers to files.
With two prefix arguments, restrict available buffers to agenda files.
Defaults to `iswitchb' for buffer name completion.
Set `org-completion-use-ido' to make it use ido instead.
With `\\[universal-argument]' prefix, restrict available buffers to files.
With `\\[universal-argument] \\[universal-argument]' prefix, restrict available buffers to agenda files.
\(fn &optional ARG)" t nil)
(defalias 'org-ido-switchb 'org-switchb)
(defalias 'org-iswitchb 'org-switchb)
(autoload 'org-cycle-agenda-files "org" "\
Cycle through the files in `org-agenda-files'.
If the current buffer visits an agenda file, find the next one in the list.
@ -23326,13 +23468,13 @@ If the current buffer does not, find the first agenda file.
\(fn)" t nil)
(autoload 'org-submit-bug-report "org" "\
Submit a bug report on Org-mode via mail.
Submit a bug report on Org via mail.
Don't hesitate to report any problems or inaccurate documentation.
If you don't have setup sending mail from (X)Emacs, please copy the
output buffer into your mail program, as it gives us important
information about your Org-mode version and configuration.
information about your Org version and configuration.
\(fn)" t nil)
@ -23388,9 +23530,9 @@ More commands can be added by configuring the variable
`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
searches can be pre-defined in this way.
If the current buffer is in Org-mode and visiting a file, you can also
If the current buffer is in Org mode and visiting a file, you can also
first press `<' once to indicate that the agenda should be temporarily
\(until the next use of \\[org-agenda]) restricted to the current file.
\(until the next use of `\\[org-agenda]') restricted to the current file.
Pressing `<' twice means to restrict to the current subtree or region
\(if active).
@ -23519,7 +23661,7 @@ in `org-agenda-text-search-extra-files'.
(autoload 'org-todo-list "org-agenda" "\
Show all (not done) TODO entries from all agenda file in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
the list to these. When using \\[universal-argument], you will be prompted
the list to these. When using `\\[universal-argument]', you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'.
@ -23575,22 +23717,22 @@ Do we have a reason to ignore this TODO entry because it has a time stamp?
(autoload 'org-agenda-set-restriction-lock "org-agenda" "\
Set restriction lock for agenda, to current subtree or file.
Restriction will be the file if TYPE is `file', or if TYPE is the
universal prefix `(4)', or if the cursor is before the first headline
Restriction will be the file if TYPE is `file', or if type is the
universal prefix \\='(4), or if the cursor is before the first headline
in the file. Otherwise, restriction will be to the current subtree.
\(fn &optional TYPE)" t nil)
(autoload 'org-calendar-goto-agenda "org-agenda" "\
Compute the Org-mode agenda for the calendar date displayed at the cursor.
Compute the Org agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'.
\(fn)" t nil)
(autoload 'org-agenda-to-appt "org-agenda" "\
Activate appointments found in `org-agenda-files'.
With a \\[universal-argument] prefix, refresh the list of
appointments.
With a `\\[universal-argument]' prefix, refresh the list of appointments.
If FILTER is t, interactively prompt the user for a regular
expression, and filter out entries that don't match it.
@ -23605,8 +23747,8 @@ argument: an entry from `org-agenda-get-day-entries'.
FILTER can also be an alist with the car of each cell being
either `headline' or `category'. For example:
((headline \"IMPORTANT\")
(category \"Work\"))
\\='((headline \"IMPORTANT\")
(category \"Work\"))
will only add headlines containing IMPORTANT or headlines
belonging to the \"Work\" category.
@ -23668,16 +23810,17 @@ Capture STRING with the template selected by KEYS.
(autoload 'org-capture "org-capture" "\
Capture something.
\\<org-capture-mode-map>
This will let you select a template from `org-capture-templates', and then
file the newly captured information. The text is immediately inserted
at the target location, and an indirect buffer is shown where you can
edit it. Pressing \\[org-capture-finalize] brings you back to the previous state
of Emacs, so that you can continue your work.
This will let you select a template from `org-capture-templates', and
then file the newly captured information. The text is immediately
inserted at the target location, and an indirect buffer is shown where
you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the previous
state of Emacs, so that you can continue your work.
When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture
anything, just go to the file/headline where the selected template
stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last note
stored.
When called interactively with a `\\[universal-argument]' prefix argument GOTO, don't
capture anything, just go to the file/headline where the selected
template stores its notes.
With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to the last note stored.
When called with a `C-0' (zero) prefix, insert a template at point.
@ -23723,26 +23866,29 @@ Remove all currently active column overlays.
\(fn)" nil nil)
(autoload 'org-columns "org-colview" "\
Turn on column view on an org-mode file.
Turn on column view on an Org mode file.
Column view applies to the whole buffer if point is before the
first headline. Otherwise, it applies to the first ancestor
setting \"COLUMNS\" property. If there is none, it defaults to
the current headline. With a `\\[universal-argument]' prefix argument, turn on column
view for the whole buffer unconditionally.
When COLUMNS-FMT-STRING is non-nil, use it as the column format.
\(fn &optional COLUMNS-FMT-STRING)" t nil)
\(fn &optional GLOBAL COLUMNS-FMT-STRING)" t nil)
(autoload 'org-columns-compute "org-colview" "\
Sum the values of property PROPERTY hierarchically, for the entire buffer.
Summarize the values of PROPERTY hierarchically.
Also update existing values for PROPERTY according to the first
column specification.
\(fn PROPERTY)" t nil)
(autoload 'org-columns-number-to-string "org-colview" "\
Convert a computed column number to a string value, according to FMT.
\(fn N FMT &optional PRINTF)" nil nil)
(autoload 'org-dblock-write:columnview "org-colview" "\
Write the column view table.
PARAMS is a property list of parameters:
:width enforce same column widths with <N> specifiers.
:id the :ID: property of the entry where the columns view
should be built. When the symbol `local', call locally.
When `global' call column view with the cursor at the beginning
@ -23752,15 +23898,17 @@ PARAMS is a property list of parameters:
using `org-id-find'.
:hlines When t, insert a hline before each item. When a number, insert
a hline before each level <= that number.
:indent When non-nil, indent each ITEM field according to its level.
:vlines When t, make each column a colgroup to enforce vertical lines.
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
When t, skip rows where all specifiers other than ITEM are empty.
:width apply widths specified in columns format using <N> specifiers.
:format When non-nil, specify the column view format to use.
\(fn PARAMS)" nil nil)
(autoload 'org-insert-columns-dblock "org-colview" "\
(autoload 'org-columns-insert-dblock "org-colview" "\
Create a dynamic block capturing a column view table.
\(fn)" t nil)
@ -23796,7 +23944,7 @@ Try very hard to provide sensible version strings.
;;;### (autoloads nil "org-ctags" "org/org-ctags.el" (0 0 0 0))
;;; Generated autoloads from org/org-ctags.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-" "y-or-n-minibuffer")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-")))
;;;***
@ -23827,7 +23975,7 @@ Try very hard to provide sensible version strings.
;;;;;; 0))
;;; Generated autoloads from org/org-entities.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("replace-amp" "org-entit")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("org-entit")))
;;;***
@ -23836,6 +23984,13 @@ Try very hard to provide sensible version strings.
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-eshell" '("org-eshell-")))
;;;***
;;;### (autoloads nil "org-eww" "org/org-eww.el" (0 0 0 0))
;;; Generated autoloads from org/org-eww.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-eww" '("org-eww-")))
;;;***
;;;### (autoloads nil "org-faces" "org/org-faces.el" (0 0 0 0))
@ -23864,7 +24019,7 @@ Try very hard to provide sensible version strings.
;;;### (autoloads nil "org-gnus" "org/org-gnus.el" (0 0 0 0))
;;; Generated autoloads from org/org-gnus.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-gnus" '("org-gnus-")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-gnus" '("org-")))
;;;***
@ -23912,6 +24067,24 @@ Try very hard to provide sensible version strings.
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-irc" '("org-irc-")))
;;;***
;;;### (autoloads nil "org-lint" "org/org-lint.el" (0 0 0 0))
;;; Generated autoloads from org/org-lint.el
(autoload 'org-lint "org-lint" "\
Check current Org buffer for syntax mistakes.
By default, run all checkers. With a `\\[universal-argument]' prefix ARG, select one
category of checkers only. With a `\\[universal-argument] \\[universal-argument]' prefix, run one precise
checker by its name.
ARG can also be a list of checker names, as symbols, to run.
\(fn &optional ARG)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-lint" '("org-lint-")))
;;;***
;;;### (autoloads nil "org-list" "org/org-list.el" (0 0 0 0))
@ -23932,7 +24105,7 @@ Try very hard to provide sensible version strings.
;;; Generated autoloads from org/org-macs.el
(autoload 'org-load-noerror-mustsuffix "org-macs" "\
Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it.
Load FILE with optional arguments NOERROR and MUSTSUFFIX.
\(fn FILE)" nil t)
@ -24004,7 +24177,7 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-table.el
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org" "*orgtbl-")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org")))
;;;***
@ -24020,14 +24193,14 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a
;;; Generated autoloads from org/org-version.el
(autoload 'org-release "org-version" "\
The release version of org-mode.
Inserted by installing org-mode or when a release is made.
The release version of Org.
Inserted by installing Org mode or when a release is made.
\(fn)" nil nil)
(autoload 'org-git-version "org-version" "\
The Git version of org-mode.
Inserted by installing org-mode or when a release is made.
Inserted by installing Org or when a release is made.
\(fn)" nil nil)
@ -26220,7 +26393,7 @@ Optional argument FACE specifies the face to do the highlighting.
;;; Generated autoloads from progmodes/python.el
(push (purecopy '(python 0 25 2)) package--builtin-versions)
(add-to-list 'auto-mode-alist (cons (purecopy "\\.pyw?\\'") 'python-mode))
(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode))
(add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode))
@ -34153,7 +34326,7 @@ Reenable Ange-FTP, when Tramp is unloaded.
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
(push (purecopy '(tramp 2 3 2)) package--builtin-versions)
(push (purecopy '(tramp 2 3 3 -1)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-")))

10
lisp/loadhist.el
View file

@ -221,6 +221,11 @@ restore a previous autoload if possible.")
;; 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.
@ -301,11 +306,6 @@ 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))))
(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))))

39
lisp/ls-lisp.el
View file

@ -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,34 @@ 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 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 ""))
(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 (file-expand-wildcards (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 +896,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

1
lisp/menu-bar.el
View file

@ -1101,6 +1101,7 @@ The selected font will be the default on both the existing and future frames."
:button (:radio . (eq tool-bar-mode nil))))
menu)))
(defvar display-line-numbers-type)
(defun menu-bar-display-line-numbers-mode (type)
(setq display-line-numbers-type type)
(if global-display-line-numbers-mode

5
lisp/newcomment.el
View file

@ -1382,10 +1382,9 @@ unless optional argument SOFT is non-nil."
(interactive)
(comment-normalize-vars t)
(let (compos comin)
;; If we are not inside a comment and we only auto-fill comments,
;; don't do anything (unless no comment syntax is defined).
;; If we are not inside a comment don't do anything (unless no
;; comment syntax is defined).
(unless (and comment-start
comment-auto-fill-only-comments
(not (called-interactively-p 'interactive))
(not (save-excursion
(prog1 (setq compos (comment-beginning))

30
lisp/password-cache.el
View file

@ -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)

26
lisp/progmodes/cc-fonts.el
View file

@ -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) ?\()

27
lisp/progmodes/cc-mode.el
View file

@ -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

90
lisp/progmodes/grep.el
View file

@ -31,7 +31,6 @@
(require 'compile)
(defgroup grep nil
"Run `grep' and display the results."
:group 'tools
@ -366,53 +365,44 @@ A grep buffer becomes most recent when you select Grep mode in it.
Notice that using \\[next-error] or \\[compile-goto-error] modifies
`compilation-last-buffer' rather than `grep-last-buffer'.")
(defconst grep--regexp-alist-column
;; Calculate column positions (col . end-col) of first grep match on a line
(cons
(lambda ()
(when grep-highlight-matches
(let* ((beg (match-end 0))
(end (save-excursion (goto-char beg) (line-end-position)))
(mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)))
(when mbeg
(- mbeg beg)))))
(lambda ()
(when grep-highlight-matches
(let* ((beg (match-end 0))
(end (save-excursion (goto-char beg) (line-end-position)))
(mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))
(mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end))))
(when mend
(- mend beg)))))))
(defconst grep--regexp-alist-bin-matcher
'("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
(defconst grep-with-null-regexp-alist
`(("^\\([^\0]+\\)\\(\0\\)\\([0-9]+\\):" 1 3 ,grep--regexp-alist-column nil nil
(2 '(face unspecified display ":")))
,grep--regexp-alist-bin-matcher)
"Regexp used to match grep hits.
See `compilation-error-regexp-alist'.")
(defconst grep-fallback-regexp-alist
`(;; Use a tight regexp to handle weird file names (with colons
;; in them) as well as possible. E.g., use [1-9][0-9]* rather
;; than [0-9]+ so as to accept ":034:" in file names.
("^\\(.*?[^/\n]\\):[ \t]*\\([1-9][0-9]*\\)[ \t]*:"
1 2 ,grep--regexp-alist-column)
,grep--regexp-alist-bin-matcher)
"Regexp used to match grep hits when `--null' is not supported.
See `compilation-error-regexp-alist'.")
(defvaralias 'grep-regex-alist 'grep-with-null-regexp-alist)
(make-obsolete-variable
'grep-regex-alist "Call `grep-regexp-alist' instead." "26.1")
;;;###autoload
(defun grep-regexp-alist ()
"Return a regexp alist to match grep hits.
The regexp used depends on `grep-use-null-filename-separator'.
See `compilation-error-regexp-alist' for format details."
(if grep-use-null-filename-separator
grep-with-null-regexp-alist grep-fallback-regexp-alist))
(defconst grep-regexp-alist
`((,(concat "^\\(?:"
;; Parse using NUL characters when `--null' is used.
;; Note that we must still assume no newlines in
;; filenames due to "foo: Is a directory." type
;; messages.
"\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):"
"\\|"
;; Fallback if `--null' is not used, use a tight regexp
;; to handle weird file names (with colons in them) as
;; well as possible. E.g., use [1-9][0-9]* rather than
;; [0-9]+ so as to accept ":034:" in file names.
"\\(?1:[^\n:]+?[^\n/:]\\):[\t ]*\\(?2:[1-9][0-9]*\\)[\t ]*:"
"\\)")
1 2
;; Calculate column positions (col . end-col) of first grep match on a line
(,(lambda ()
(when grep-highlight-matches
(let* ((beg (match-end 0))
(end (save-excursion (goto-char beg) (line-end-position)))
(mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)))
(when mbeg
(- mbeg beg)))))
.
,(lambda ()
(when grep-highlight-matches
(let* ((beg (match-end 0))
(end (save-excursion (goto-char beg) (line-end-position)))
(mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))
(mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end))))
(when mend
(- mend beg))))))
nil nil
(3 '(face nil display ":")))
("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
"Regexp used to match grep hits.
See `compilation-error-regexp-alist' for format details.")
(defvar grep-first-column 0 ; bug#10594
"Value to use for `compilation-first-column' in grep buffers.")
@ -451,7 +441,9 @@ See `compilation-error-regexp-alist' for format details."
(2 grep-error-face nil t))
;; "filename-linenumber-" format is used for context lines in GNU grep,
;; "filename=linenumber=" for lines with function names in "git grep -p".
("^.+?[-=][0-9]+[-=].*\n" (0 grep-context-face)))
("^.+?\\([-=\0]\\)[0-9]+\\([-=]\\).*\n" (0 grep-context-face)
(1 (if (eq (char-after (match-beginning 1)) ?\0)
`(face nil display ,(match-string 2))))))
"Additional things to highlight in grep output.
This gets tacked on the end of the generated expressions.")
@ -781,7 +773,7 @@ This function is called from `compilation-filter-hook'."
(set (make-local-variable 'compilation-error-face)
grep-hit-face)
(set (make-local-variable 'compilation-error-regexp-alist)
(grep-regexp-alist))
grep-regexp-alist)
;; compilation-directory-matcher can't be nil, so we set it to a regexp that
;; can never match.
(set (make-local-variable 'compilation-directory-matcher) '("\\`a\\`"))

1
lisp/progmodes/sh-script.el
View file

@ -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")

2
lisp/progmodes/xref.el
View file

@ -929,7 +929,7 @@ IGNORES is a list of glob patterns."
(expand-file-name dir)
ignores))
(buf (get-buffer-create " *xref-grep*"))
(`(,grep-re ,file-group ,line-group . ,_) (car (grep-regexp-alist)))
(`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
(status nil)
(hits nil))
(with-current-buffer buf

4
lisp/register.el
View file

@ -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))

5
lisp/replace.el
View file

@ -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'.

21
lisp/ruler-mode.el
View file

@ -304,7 +304,10 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(defsubst ruler-mode-window-col (n)
"Return a column number relative to the selected window.
N is a column number relative to selected frame."
N is a column number relative to selected frame.
If required, account for screen estate taken by `display-line-numbers'."
(if display-line-numbers
(setq n (- n (line-number-display-width) 2)))
(- n
(or (car (window-margins)) 0)
(fringe-columns 'left)
@ -665,7 +668,7 @@ Optional argument PROPS specifies other text properties to apply."
(let* ((w (ruler-mode-text-scaled-window-width))
(m (window-margins))
(f (window-fringes))
(i 0)
(i (if display-line-numbers (+ (line-number-display-width) 2) 0))
(j (ruler-mode-text-scaled-window-hscroll))
;; Setup the scrollbar, fringes, and margins areas.
(lf (ruler-mode-space
@ -696,8 +699,20 @@ 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))
;; Make the part of header-line corresponding to the
;; line-number display be blank, not filled with
;; ruler-mode-basic-graduation-char.
(if display-line-numbers
(let* ((lndw (+ (line-number-display-width) 2))
(s (make-string lndw ?\s)))
(concat s (make-string (- w lndw)
ruler-mode-basic-graduation-char)))
(make-string w ruler-mode-basic-graduation-char)))
'face 'ruler-mode-default
'local-map ruler-mode-map
'help-echo (cond

4
lisp/shell.el
View file

@ -264,7 +264,9 @@ see the function `dirtrack-mode'."
:group 'shell-directories)
(defcustom explicit-shell-file-name nil
"If non-nil, is file name to use for explicitly requested inferior shell."
"If non-nil, is file name to use for explicitly requested inferior shell.
When nil, such interactive shell sessions fallback to using either
the shell specified in $ESHELL or in `shell-file-name'."
:type '(choice (const :tag "None" nil) file)
:group 'shell)

30
lisp/simple.el
View file

@ -996,23 +996,24 @@ instead of deleted."
:version "24.1")
(defvar region-extract-function
(lambda (delete)
(lambda (method)
(when (region-beginning)
(cond
((eq delete 'bounds)
((eq method 'bounds)
(list (cons (region-beginning) (region-end))))
((eq delete 'delete-only)
((eq method 'delete-only)
(delete-region (region-beginning) (region-end)))
(t
(filter-buffer-substring (region-beginning) (region-end) delete)))))
(filter-buffer-substring (region-beginning) (region-end) method)))))
"Function to get the region's content.
Called with one argument DELETE.
If DELETE is `delete-only', then only delete the region and the return value
is undefined. If DELETE is nil, just return the content as a string.
If DELETE is `bounds', then don't delete, but just return the
boundaries of the region as a list of (START . END) positions.
If anything else, delete the region and return its content as a string,
after filtering it with `filter-buffer-substring'.")
Called with one argument METHOD.
If METHOD is `delete-only', then delete the region; the return value
is undefined. If METHOD is nil, then return the content as a string.
If METHOD is `bounds', then return the boundaries of the region
as a list of the form (START . END).
If METHOD is anything else, delete the region and return its content
as a string, after filtering it with `filter-buffer-substring', which
is called with METHOD as its 3rd argument.")
(defvar region-insert-function
(lambda (lines)
@ -7218,6 +7219,13 @@ unless optional argument SOFT is non-nil."
;; If we're not inside a comment, just try to indent.
(t (indent-according-to-mode))))))
(defun internal-auto-fill ()
"The function called by `self-insert-command' to perform auto-filling."
(when (or (not comment-start)
(not comment-auto-fill-only-comments)
(nth 4 (syntax-ppss)))
(do-auto-fill)))
(defvar normal-auto-fill-function 'do-auto-fill
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
Some major modes set this.")

76
lisp/subr.el
View file

@ -1999,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,
@ -2008,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.

6
lisp/term.el
View file

@ -1354,8 +1354,7 @@ commands to use in that buffer.
(interactive (list (read-from-minibuffer "Run program: "
(or explicit-shell-file-name
(getenv "ESHELL")
(getenv "SHELL")
"/bin/sh"))))
shell-file-name))))
(set-buffer (make-term "terminal" program))
(term-mode)
(term-char-mode)
@ -4149,8 +4148,7 @@ the process. Any more args are arguments to PROGRAM."
(interactive (list (read-from-minibuffer "Run program: "
(or explicit-shell-file-name
(getenv "ESHELL")
(getenv "SHELL")
"/bin/sh"))))
shell-file-name))))
;; Pick the name of the new buffer.
(setq term-ansi-buffer-name

2
lisp/term/ns-win.el
View file

@ -774,7 +774,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(defun ns-suspend-error ()
;; Don't allow suspending if any of the frames are NS frames.
(if (memq 'ns (mapcar 'window-system (frame-list)))
(error "Cannot suspend Emacs while running under NS")))
(error "Cannot suspend Emacs while an NS GUI frame exists")))
;; Set some options to be as Nextstep-like as possible.

2
lisp/term/x-win.el
View file

@ -1182,7 +1182,7 @@ as returned by `x-server-vendor'."
This returns an error if any Emacs frames are X frames."
;; Don't allow suspending if any of the frames are X frames.
(if (memq 'x (mapcar #'window-system (frame-list)))
(error "Cannot suspend Emacs while running under X")))
(error "Cannot suspend Emacs while an X GUI frame exists")))
(defvar x-initialized nil
"Non-nil if the X window system has been initialized.")

2
lisp/textmodes/artist.el
View file

@ -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)

2
lisp/textmodes/css-mode.el
View file

@ -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)))

41
lisp/url/url-cookie.el
View file

@ -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}"

66
lisp/vc/smerge-mode.el
View file

@ -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.

2
lisp/whitespace.el
View file

@ -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.

32
m4/d-type.m4 Normal file
View file

@ -0,0 +1,32 @@
# serial 12
dnl From Jim Meyering.
dnl
dnl Check whether struct dirent has a member named d_type.
dnl
# Copyright (C) 1997, 1999-2004, 2006, 2009-2017 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE],
[AC_CACHE_CHECK([for d_type member in directory struct],
[gl_cv_struct_dirent_d_type],
[AC_LINK_IFELSE([AC_LANG_PROGRAM([[
#include <sys/types.h>
#include <dirent.h>
]],
[[struct dirent dp; dp.d_type = 0;]])],
[gl_cv_struct_dirent_d_type=yes],
[gl_cv_struct_dirent_d_type=no])
]
)
if test $gl_cv_struct_dirent_d_type = yes; then
AC_DEFINE([HAVE_STRUCT_DIRENT_D_TYPE], [1],
[Define if there is a member named d_type in the struct describing
directory headers.])
fi
]
)

3
m4/gnulib-comp.m4
View file

@ -61,6 +61,7 @@ AC_DEFUN([gl_EARLY],
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module crypto/sha512:
# Code from module d-type:
# Code from module diffseq:
# Code from module dirent:
# Code from module dirfd:
@ -199,6 +200,7 @@ AC_DEFUN([gl_INIT],
gl_SHA1
gl_SHA256
gl_SHA512
gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE
gl_DIRENT_H
AC_REQUIRE([gl_C99_STRTOLD])
gl_FUNC_DUP2
@ -968,6 +970,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/count-leading-zeros.m4
m4/count-one-bits.m4
m4/count-trailing-zeros.m4
m4/d-type.m4
m4/dirent_h.m4
m4/dirfd.m4
m4/dup2.m4

19
m4/manywarnings.m4
View file

@ -1,4 +1,4 @@
# manywarnings.m4 serial 8
# manywarnings.m4 serial 10
dnl Copyright (C) 2008-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@ -258,9 +258,20 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC],
# gcc --help=warnings outputs an unusual form for these options; list
# them here so that the above 'comm' command doesn't report a false match.
# Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal:
ptrdiff_max_max=9223372036854775807
gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$ptrdiff_max_max"
# Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal
# and AC_COMPUTE_INT requires it to fit in a long:
AC_MSG_CHECKING([max safe object size])
AC_COMPUTE_INT([gl_alloc_max],
[(LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) < (size_t) -1
? (LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX)
: (size_t) -1],
[[#include <limits.h>
#include <stddef.h>
#include <stdint.h>
]],
[gl_alloc_max=2147483647])
AC_MSG_RESULT([$gl_alloc_max])
gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max"
gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2"
gl_manywarn_set="$gl_manywarn_set -Wformat-overflow=2"
gl_manywarn_set="$gl_manywarn_set -Wformat-truncation=2"

3
src/buffer.c
View file

@ -1077,7 +1077,8 @@ is first appended to NAME, to speed up finding a non-existent buffer. */)
CHECK_STRING (name);
if (!NILP (Fstring_equal (name, ignore)) || NILP (Fget_buffer (name)))
if ((!NILP (ignore) && !NILP (Fstring_equal (name, ignore)))
|| NILP (Fget_buffer (name)))
return name;
if (SREF (name, 0) != ' ') /* See bug#1229. */

11
src/cmds.c
View file

@ -268,9 +268,10 @@ Whichever character you type to run this command is inserted.
The numeric prefix argument N says how many times to repeat the insertion.
Before insertion, `expand-abbrev' is executed if the inserted character does
not have word syntax and the previous character in the buffer does.
After insertion, the value of `auto-fill-function' is called if the
`auto-fill-chars' table has a non-nil value for the inserted character.
At the end, it runs `post-self-insert-hook'. */)
After insertion, `internal-auto-fill' is called if
`auto-fill-function' is non-nil and if the `auto-fill-chars' table has
a non-nil value for the inserted character. At the end, it runs
`post-self-insert-hook'. */)
(Lisp_Object n)
{
CHECK_NUMBER (n);
@ -475,7 +476,7 @@ internal_self_insert (int c, EMACS_INT n)
that. Must have the newline in place already so filling and
justification, if any, know where the end is going to be. */
SET_PT_BOTH (PT - 1, PT_BYTE - 1);
auto_fill_result = call0 (BVAR (current_buffer, auto_fill_function));
auto_fill_result = call0 (Qinternal_auto_fill);
/* Test PT < ZV in case the auto-fill-function is strange. */
if (c == '\n' && PT < ZV)
SET_PT_BOTH (PT + 1, PT_BYTE + 1);
@ -494,6 +495,8 @@ internal_self_insert (int c, EMACS_INT n)
void
syms_of_cmds (void)
{
DEFSYM (Qinternal_auto_fill, "internal-auto-fill");
DEFSYM (Qundo_auto_amalgamate, "undo-auto-amalgamate");
DEFSYM (Qundo_auto__this_command_amalgamating,
"undo-auto--this-command-amalgamating");

71
src/dired.c
View file

@ -64,6 +64,21 @@ dirent_namelen (struct dirent *dp)
#endif
}
#ifndef HAVE_STRUCT_DIRENT_D_TYPE
enum { DT_UNKNOWN, DT_DIR, DT_LNK };
#endif
/* Return the file type of DP. */
static int
dirent_type (struct dirent *dp)
{
#ifdef HAVE_STRUCT_DIRENT_D_TYPE
return dp->d_type;
#else
return DT_UNKNOWN;
#endif
}
static DIR *
open_directory (Lisp_Object dirname, int *fdp)
{
@ -434,7 +449,7 @@ is matched against file and directory names relative to DIRECTORY. */)
return file_name_completion (file, directory, 1, Qnil);
}
static int file_name_completion_stat (int, struct dirent *, struct stat *);
static bool file_name_completion_dirp (int, struct dirent *, ptrdiff_t);
static Lisp_Object
file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
@ -448,7 +463,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
Lisp_Object bestmatch, tem, elt, name;
Lisp_Object encoded_file;
Lisp_Object encoded_dir;
struct stat st;
bool directoryp;
/* If not INCLUDEALL, exclude files in completion-ignored-extensions as
well as "." and "..". Until shown otherwise, assume we can't exclude
@ -512,10 +526,21 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
>= 0))
continue;
if (file_name_completion_stat (fd, dp, &st) < 0)
continue;
switch (dirent_type (dp))
{
case DT_DIR:
directoryp = true;
break;
case DT_LNK: case DT_UNKNOWN:
directoryp = file_name_completion_dirp (fd, dp, len);
break;
default:
directoryp = false;
break;
}
directoryp = S_ISDIR (st.st_mode) != 0;
tem = Qnil;
/* If all_flag is set, always include all.
It would not actually be helpful to the user to ignore any possible
@ -781,32 +806,18 @@ scmp (const char *s1, const char *s2, ptrdiff_t len)
return len - l;
}
static int
file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)
/* Return true if in the directory FD the directory entry DP, whose
string length is LEN, is that of a subdirectory that can be searched. */
static bool
file_name_completion_dirp (int fd, struct dirent *dp, ptrdiff_t len)
{
int value;
#ifdef MSDOS
/* Some fields of struct stat are *very* expensive to compute on MS-DOS,
but aren't required here. Avoid computing the following fields:
st_inode, st_size and st_nlink for directories, and the execute bits
in st_mode for non-directory files with non-standard extensions. */
unsigned short save_djstat_flags = _djstat_flags;
_djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
#endif /* MSDOS */
/* We want to return success if a link points to a nonexistent file,
but we want to return the status for what the link points to,
in case it is a directory. */
value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);
if (value == 0 && S_ISLNK (st_addr->st_mode))
fstatat (fd, dp->d_name, st_addr, 0);
#ifdef MSDOS
_djstat_flags = save_djstat_flags;
#endif /* MSDOS */
return value;
USE_SAFE_ALLOCA;
char *subdir_name = SAFE_ALLOCA (len + 2);
memcpy (subdir_name, dp->d_name, len);
strcpy (subdir_name + len, "/");
bool dirp = faccessat (fd, subdir_name, F_OK, AT_EACCESS) == 0;
SAFE_FREE ();
return dirp;
}
static char *

128
src/eval.c
View file

@ -354,10 +354,11 @@ usage: (or CONDITIONS...) */)
while (CONSP (args))
{
val = eval_sub (XCAR (args));
Lisp_Object arg = XCAR (args);
args = XCDR (args);
val = eval_sub (arg);
if (!NILP (val))
break;
args = XCDR (args);
}
return val;
@ -374,10 +375,11 @@ usage: (and CONDITIONS...) */)
while (CONSP (args))
{
val = eval_sub (XCAR (args));
Lisp_Object arg = XCAR (args);
args = XCDR (args);
val = eval_sub (arg);
if (NILP (val))
break;
args = XCDR (args);
}
return val;
@ -397,7 +399,7 @@ usage: (if COND THEN ELSE...) */)
if (!NILP (cond))
return eval_sub (Fcar (XCDR (args)));
return Fprogn (XCDR (XCDR (args)));
return Fprogn (Fcdr (XCDR (args)));
}
DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
@ -439,8 +441,9 @@ usage: (progn BODY...) */)
while (CONSP (body))
{
val = eval_sub (XCAR (body));
Lisp_Object form = XCAR (body);
body = XCDR (body);
val = eval_sub (form);
}
return val;
@ -488,35 +491,26 @@ The return value of the `setq' form is the value of the last VAL.
usage: (setq [SYM VAL]...) */)
(Lisp_Object args)
{
Lisp_Object val, sym, lex_binding;
Lisp_Object val = args, tail = args;
val = args;
if (CONSP (args))
for (EMACS_INT nargs = 0; CONSP (tail); nargs += 2)
{
Lisp_Object args_left = args;
Lisp_Object numargs = Flength (args);
if (XINT (numargs) & 1)
xsignal2 (Qwrong_number_of_arguments, Qsetq, numargs);
do
{
val = eval_sub (Fcar (XCDR (args_left)));
sym = XCAR (args_left);
/* Like for eval_sub, we do not check declared_special here since
it's been done when let-binding. */
if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
&& SYMBOLP (sym)
&& !NILP (lex_binding
= Fassq (sym, Vinternal_interpreter_environment)))
XSETCDR (lex_binding, val); /* SYM is lexically bound. */
else
Fset (sym, val); /* SYM is dynamically bound. */
args_left = Fcdr (XCDR (args_left));
}
while (CONSP (args_left));
Lisp_Object sym = XCAR (tail), lex_binding;
tail = XCDR (tail);
if (!CONSP (tail))
xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1));
Lisp_Object arg = XCAR (tail);
tail = XCDR (tail);
val = eval_sub (arg);
/* Like for eval_sub, we do not check declared_special here since
it's been done when let-binding. */
if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
&& SYMBOLP (sym)
&& !NILP (lex_binding
= Fassq (sym, Vinternal_interpreter_environment)))
XSETCDR (lex_binding, val); /* SYM is lexically bound. */
else
Fset (sym, val); /* SYM is dynamically bound. */
}
return val;
@ -535,7 +529,7 @@ of unexpected results when a quoted object is modified.
usage: (quote ARG) */)
(Lisp_Object args)
{
if (CONSP (XCDR (args)))
if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
return XCAR (args);
}
@ -549,7 +543,7 @@ usage: (function ARG) */)
{
Lisp_Object quoted = XCAR (args);
if (CONSP (XCDR (args)))
if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
if (!NILP (Vinternal_interpreter_environment)
@ -734,9 +728,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
sym = XCAR (args);
tail = XCDR (args);
if (CONSP (tail))
if (!NILP (tail))
{
if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail))))
if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail))))
error ("Too many arguments");
tem = Fdefault_boundp (sym);
@ -803,20 +797,24 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
Lisp_Object sym, tem;
sym = XCAR (args);
if (CONSP (Fcdr (XCDR (XCDR (args)))))
error ("Too many arguments");
Lisp_Object docstring = Qnil;
if (!NILP (XCDR (XCDR (args))))
{
if (!NILP (XCDR (XCDR (XCDR (args)))))
error ("Too many arguments");
docstring = XCAR (XCDR (XCDR (args)));
}
tem = eval_sub (Fcar (XCDR (args)));
tem = eval_sub (XCAR (XCDR (args)));
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fset_default (sym, tem);
XSYMBOL (sym)->declared_special = 1;
tem = Fcar (XCDR (XCDR (args)));
if (!NILP (tem))
if (!NILP (docstring))
{
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
docstring = Fpurecopy (docstring);
Fput (sym, Qvariable_documentation, docstring);
}
Fput (sym, Qrisky_local_variable, Qt);
LOADHIST_ATTACH (sym);
@ -844,27 +842,29 @@ Each VALUEFORM can refer to the symbols already bound by this VARLIST.
usage: (let* VARLIST BODY...) */)
(Lisp_Object args)
{
Lisp_Object varlist, var, val, elt, lexenv;
Lisp_Object var, val, elt, lexenv;
ptrdiff_t count = SPECPDL_INDEX ();
lexenv = Vinternal_interpreter_environment;
for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist))
Lisp_Object varlist = XCAR (args);
while (CONSP (varlist))
{
maybe_quit ();
elt = XCAR (varlist);
varlist = XCDR (varlist);
if (SYMBOLP (elt))
{
var = elt;
val = Qnil;
}
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
{
var = Fcar (elt);
val = eval_sub (Fcar (Fcdr (elt)));
if (! NILP (Fcdr (XCDR (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
val = eval_sub (Fcar (XCDR (elt)));
}
if (!NILP (lexenv) && SYMBOLP (var)
@ -911,33 +911,37 @@ usage: (let VARLIST BODY...) */)
CHECK_LIST (varlist);
/* Make space to hold the values to give the bound variables. */
elt = Flength (varlist);
SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
EMACS_INT varlist_len = XFASTINT (Flength (varlist));
SAFE_ALLOCA_LISP (temps, varlist_len);
ptrdiff_t nvars = varlist_len;
/* Compute the values and store them in `temps'. */
for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
{
maybe_quit ();
elt = XCAR (varlist);
varlist = XCDR (varlist);
if (SYMBOLP (elt))
temps [argnum++] = Qnil;
temps[argnum] = Qnil;
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
temps[argnum] = eval_sub (Fcar (Fcdr (elt)));
}
nvars = argnum;
lexenv = Vinternal_interpreter_environment;
varlist = XCAR (args);
for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
{
Lisp_Object var;
elt = XCAR (varlist);
varlist = XCDR (varlist);
var = SYMBOLP (elt) ? elt : Fcar (elt);
tem = temps[argnum++];
tem = temps[argnum];
if (!NILP (lexenv) && SYMBOLP (var)
&& !XSYMBOL (var)->declared_special
@ -2135,6 +2139,7 @@ eval_sub (Lisp_Object form)
original_fun = XCAR (form);
original_args = XCDR (form);
CHECK_LIST (original_args);
/* This also protects them from gc. */
count = record_in_backtrace (original_fun, &original_args, UNEVALLED);
@ -2176,15 +2181,16 @@ eval_sub (Lisp_Object form)
SAFE_ALLOCA_LISP (vals, XINT (numargs));
while (!NILP (args_left))
while (CONSP (args_left) && argnum < XINT (numargs))
{
vals[argnum++] = eval_sub (Fcar (args_left));
args_left = Fcdr (args_left);
Lisp_Object arg = XCAR (args_left);
args_left = XCDR (args_left);
vals[argnum++] = eval_sub (arg);
}
set_backtrace_args (specpdl + count, vals, XINT (numargs));
set_backtrace_args (specpdl + count, vals, argnum);
val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
val = XSUBR (fun)->function.aMANY (argnum, vals);
check_cons_list ();
lisp_eval_depth--;

158
src/fileio.c
View file

@ -2216,7 +2216,7 @@ With a prefix argument, TRASH is nil. */)
encoded_file = ENCODE_FILE (filename);
if (unlink (SSDATA (encoded_file)) < 0)
if (unlink (SSDATA (encoded_file)) != 0 && errno != ENOENT)
report_file_error ("Removing old name", filename);
return Qnil;
}
@ -2311,6 +2311,7 @@ This is what happens in interactive use with M-x. */)
{
Lisp_Object handler;
Lisp_Object encoded_file, encoded_newname, symlink_target;
int dirp = -1;
symlink_target = encoded_file = encoded_newname = Qnil;
CHECK_STRING (file);
@ -2324,8 +2325,8 @@ This is what happens in interactive use with M-x. */)
&& (NILP (Ffile_name_case_insensitive_p (file))
|| NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))))
{
Lisp_Object fname = (NILP (Ffile_directory_p (file))
? file : Fdirectory_file_name (file));
dirp = !NILP (Ffile_directory_p (file));
Lisp_Object fname = dirp ? Fdirectory_file_name (file) : file;
newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname);
}
else
@ -2344,46 +2345,69 @@ This is what happens in interactive use with M-x. */)
encoded_newname = ENCODE_FILE (newname);
/* If the filesystem is case-insensitive and the file names are
identical but for the case, don't ask for confirmation: they
simply want to change the letter-case of the file name. */
if ((!(file_name_case_insensitive_p (SSDATA (encoded_file)))
|| NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
&& ((NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))))
barf_or_query_if_file_exists (newname, false, "rename to it",
INTEGERP (ok_if_already_exists), false);
if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
identical but for the case, don't worry whether the destination
already exists: the caller simply wants to change the letter-case
of the file name. */
bool plain_rename
= ((!NILP (ok_if_already_exists) && !INTEGERP (ok_if_already_exists))
|| (file_name_case_insensitive_p (SSDATA (encoded_file))
&& ! NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))));
int rename_errno;
if (!plain_rename)
{
int rename_errno = errno;
if (rename_errno == EXDEV)
if (renameat_noreplace (AT_FDCWD, SSDATA (encoded_file),
AT_FDCWD, SSDATA (encoded_newname))
== 0)
return Qnil;
rename_errno = errno;
switch (rename_errno)
{
ptrdiff_t count;
symlink_target = Ffile_symlink_p (file);
if (! NILP (symlink_target))
Fmake_symbolic_link (symlink_target, newname,
NILP (ok_if_already_exists) ? Qnil : Qt);
else if (!NILP (Ffile_directory_p (file)))
call4 (Qcopy_directory, file, newname, Qt, Qnil);
else
/* We have already prompted if it was an integer, so don't
have copy-file prompt again. */
Fcopy_file (file, newname,
NILP (ok_if_already_exists) ? Qnil : Qt,
Qt, Qt, Qt);
count = SPECPDL_INDEX ();
specbind (Qdelete_by_moving_to_trash, Qnil);
if (!NILP (Ffile_directory_p (file)) && NILP (symlink_target))
call2 (Qdelete_directory, file, Qt);
else
Fdelete_file (file, Qnil);
unbind_to (count, Qnil);
case EEXIST: case EINVAL: case ENOSYS:
barf_or_query_if_file_exists (newname, rename_errno == EEXIST,
"rename to it",
INTEGERP (ok_if_already_exists),
false);
plain_rename = true;
break;
}
else
report_file_errno ("Renaming", list2 (file, newname), rename_errno);
}
return Qnil;
if (plain_rename)
{
if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
return Qnil;
rename_errno = errno;
/* Don't prompt again. */
ok_if_already_exists = Qt;
}
else if (!NILP (ok_if_already_exists))
ok_if_already_exists = Qt;
if (rename_errno != EXDEV)
report_file_errno ("Renaming", list2 (file, newname), rename_errno);
symlink_target = Ffile_symlink_p (file);
if (!NILP (symlink_target))
Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists);
else
{
if (dirp < 0)
dirp = !NILP (Ffile_directory_p (file));
if (dirp)
call4 (Qcopy_directory, file, newname, Qt, Qnil);
else
Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt);
}
ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qdelete_by_moving_to_trash, Qnil);
if (dirp && NILP (symlink_target))
call2 (Qdelete_directory, file, Qt);
else
Fdelete_file (file, Qnil);
return unbind_to (count, Qnil);
}
DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
@ -2425,19 +2449,21 @@ This is what happens in interactive use with M-x. */)
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, false, "make it a new name",
INTEGERP (ok_if_already_exists), false);
if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
return Qnil;
unlink (SSDATA (newname));
if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
if (errno == EEXIST)
{
int link_errno = errno;
report_file_errno ("Adding new name", list2 (file, newname), link_errno);
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, true, "make it a new name",
INTEGERP (ok_if_already_exists), false);
unlink (SSDATA (newname));
if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
return Qnil;
}
return Qnil;
report_file_error ("Adding new name", list2 (file, newname));
}
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
@ -2484,31 +2510,25 @@ This happens for interactive use with M-x. */)
encoded_target = ENCODE_FILE (target);
encoded_linkname = ENCODE_FILE (linkname);
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, false, "make it a link",
INTEGERP (ok_if_already_exists), false);
if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) < 0)
{
/* If we didn't complain already, silently delete existing file. */
int symlink_errno;
if (errno == EEXIST)
{
unlink (SSDATA (encoded_linkname));
if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname))
>= 0)
return Qnil;
}
if (errno == ENOSYS)
xsignal1 (Qfile_error,
build_string ("Symbolic links are not supported"));
if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
return Qnil;
symlink_errno = errno;
report_file_errno ("Making symbolic link", list2 (target, linkname),
symlink_errno);
if (errno == ENOSYS)
xsignal1 (Qfile_error,
build_string ("Symbolic links are not supported"));
if (errno == EEXIST)
{
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, true, "make it a link",
INTEGERP (ok_if_already_exists), false);
unlink (SSDATA (encoded_linkname));
if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
return Qnil;
}
return Qnil;
report_file_error ("Making symbolic link", list2 (target, linkname));
}

3
src/filelock.c
View file

@ -339,6 +339,9 @@ rename_lock_file (char const *old, char const *new, bool force)
{
struct stat st;
int r = renameat_noreplace (AT_FDCWD, old, AT_FDCWD, new);
if (! (r < 0 && errno == ENOSYS))
return r;
if (link (old, new) == 0)
return unlink (old) == 0 || errno == ENOENT ? 0 : -1;
if (errno != ENOSYS && errno != LINKS_MIGHT_NOT_WORK)

370
src/gnutls.c
View file

@ -26,12 +26,26 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "coding.h"
#include "buffer.h"
#if 0x030014 <= GNUTLS_VERSION_NUMBER
# define HAVE_GNUTLS_X509_SYSTEM_TRUST
#endif
/* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14,
it was broken through at least GnuTLS 3.4.10; see:
https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00992.html
The relevant fix seems to have been made in GnuTLS 3.5.1; see:
https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d
So, require 3.5.1. */
#if 0x030501 <= GNUTLS_VERSION_NUMBER
# define HAVE_GNUTLS_AEAD
#endif
#ifdef HAVE_GNUTLS
#ifdef WINDOWSNT
#include <windows.h>
#include "w32.h"
#endif
# ifdef WINDOWSNT
# include <windows.h>
# include "w32.h"
# endif
static bool emacs_gnutls_handle_error (gnutls_session_t, int);
@ -39,9 +53,9 @@ static bool gnutls_global_initialized;
static void gnutls_log_function (int, const char *);
static void gnutls_log_function2 (int, const char *, const char *);
#ifdef HAVE_GNUTLS3
# ifdef HAVE_GNUTLS3
static void gnutls_audit_log_function (gnutls_session_t, const char *);
#endif
# endif
enum extra_peer_verification
{
@ -49,7 +63,7 @@ enum extra_peer_verification
};
#ifdef WINDOWSNT
# ifdef WINDOWSNT
DEF_DLL_FN (gnutls_alert_description_t, gnutls_alert_get,
(gnutls_session_t));
@ -74,12 +88,10 @@ DEF_DLL_FN (int, gnutls_certificate_set_x509_crl_file,
DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file,
(gnutls_certificate_credentials_t, const char *, const char *,
gnutls_x509_crt_fmt_t));
# if ((GNUTLS_VERSION_MAJOR \
+ (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20)) \
> 3)
# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust,
(gnutls_certificate_credentials_t));
# endif
# endif
DEF_DLL_FN (int, gnutls_certificate_set_x509_trust_file,
(gnutls_certificate_credentials_t, const char *,
gnutls_x509_crt_fmt_t));
@ -96,9 +108,9 @@ DEF_DLL_FN (int, gnutls_dh_get_prime_bits, (gnutls_session_t));
DEF_DLL_FN (int, gnutls_error_is_fatal, (int));
DEF_DLL_FN (int, gnutls_global_init, (void));
DEF_DLL_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
# ifdef HAVE_GNUTLS3
# ifdef HAVE_GNUTLS3
DEF_DLL_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func));
# endif
# endif
DEF_DLL_FN (void, gnutls_global_set_log_level, (int));
DEF_DLL_FN (int, gnutls_handshake, (gnutls_session_t));
DEF_DLL_FN (int, gnutls_init, (gnutls_session_t *, unsigned int));
@ -172,14 +184,13 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name,
DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
# ifdef HAVE_GNUTLS3
# ifdef HAVE_GNUTLS3
DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t));
DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void));
DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t));
# ifdef HAVE_GNUTLS3_CIPHER
DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void));
DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t));
DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t));
@ -194,7 +205,7 @@ DEF_DLL_FN (int, gnutls_cipher_encrypt2,
DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t));
DEF_DLL_FN (int, gnutls_cipher_decrypt2,
(gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
# ifdef HAVE_GNUTLS3_AEAD
# ifdef HAVE_GNUTLS_AEAD
DEF_DLL_FN (int, gnutls_aead_cipher_init,
(gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t,
const gnutls_datum_t *));
@ -205,25 +216,20 @@ DEF_DLL_FN (int, gnutls_aead_cipher_encrypt,
DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
(gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
size_t, size_t, const void *, size_t, void *, size_t *));
# endif /* HAVE_GNUTLS3_AEAD */
# ifdef HAVE_GNUTLS3_HMAC
# endif
DEF_DLL_FN (int, gnutls_hmac_init,
(gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t));
DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *));
DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *));
# endif /* HAVE_GNUTLS3_HMAC */
# endif /* HAVE_GNUTLS3_CIPHER */
# ifdef HAVE_GNUTLS3_DIGEST
DEF_DLL_FN (int, gnutls_hash_init,
(gnutls_hash_hd_t *, gnutls_digest_algorithm_t));
DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t));
DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t));
DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *));
DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *));
# endif /* HAVE_GNUTLS3_DIGEST */
# endif /* HAVE_GNUTLS3 */
# endif /* HAVE_GNUTLS3 */
static bool
@ -249,11 +255,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_certificate_set_verify_flags);
LOAD_DLL_FN (library, gnutls_certificate_set_x509_crl_file);
LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file);
# if ((GNUTLS_VERSION_MAJOR \
+ (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20)) \
> 3)
# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust);
# endif
# endif
LOAD_DLL_FN (library, gnutls_certificate_set_x509_trust_file);
LOAD_DLL_FN (library, gnutls_certificate_type_get);
LOAD_DLL_FN (library, gnutls_certificate_verify_peers2);
@ -264,9 +268,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_error_is_fatal);
LOAD_DLL_FN (library, gnutls_global_init);
LOAD_DLL_FN (library, gnutls_global_set_log_function);
# ifdef HAVE_GNUTLS3
# ifdef HAVE_GNUTLS3
LOAD_DLL_FN (library, gnutls_global_set_audit_log_function);
# endif
# endif
LOAD_DLL_FN (library, gnutls_global_set_log_level);
LOAD_DLL_FN (library, gnutls_handshake);
LOAD_DLL_FN (library, gnutls_init);
@ -309,14 +313,13 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_cipher_get_name);
LOAD_DLL_FN (library, gnutls_mac_get);
LOAD_DLL_FN (library, gnutls_mac_get_name);
# ifdef HAVE_GNUTLS3
# ifdef HAVE_GNUTLS3
LOAD_DLL_FN (library, gnutls_rnd);
LOAD_DLL_FN (library, gnutls_mac_list);
LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
LOAD_DLL_FN (library, gnutls_mac_get_key_size);
LOAD_DLL_FN (library, gnutls_digest_list);
LOAD_DLL_FN (library, gnutls_digest_get_name);
# ifdef HAVE_GNUTLS3_CIPHER
LOAD_DLL_FN (library, gnutls_cipher_list);
LOAD_DLL_FN (library, gnutls_cipher_get_iv_size);
LOAD_DLL_FN (library, gnutls_cipher_get_key_size);
@ -327,28 +330,23 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_cipher_encrypt2);
LOAD_DLL_FN (library, gnutls_cipher_deinit);
LOAD_DLL_FN (library, gnutls_cipher_decrypt2);
# ifdef HAVE_GNUTLS3_AEAD
# ifdef HAVE_GNUTLS_AEAD
LOAD_DLL_FN (library, gnutls_aead_cipher_init);
LOAD_DLL_FN (library, gnutls_aead_cipher_deinit);
LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
# endif
# ifdef HAVE_GNUTLS3_HMAC
LOAD_DLL_FN (library, gnutls_hmac_init);
LOAD_DLL_FN (library, gnutls_hmac_get_len);
LOAD_DLL_FN (library, gnutls_hmac);
LOAD_DLL_FN (library, gnutls_hmac_deinit);
LOAD_DLL_FN (library, gnutls_hmac_output);
# endif /* HAVE_GNUTLS3_HMAC */
# endif /* HAVE_GNUTLS3_CIPHER */
# ifdef HAVE_GNUTLS3_DIGEST
LOAD_DLL_FN (library, gnutls_hash_init);
LOAD_DLL_FN (library, gnutls_hash_get_len);
LOAD_DLL_FN (library, gnutls_hash);
LOAD_DLL_FN (library, gnutls_hash_deinit);
LOAD_DLL_FN (library, gnutls_hash_output);
# endif
# endif /* HAVE_GNUTLS3 */
# endif /* HAVE_GNUTLS3 */
max_log_level = global_gnutls_log_level;
@ -361,111 +359,105 @@ init_gnutls_functions (void)
return 1;
}
# define gnutls_alert_get fn_gnutls_alert_get
# define gnutls_alert_get_name fn_gnutls_alert_get_name
# define gnutls_anon_allocate_client_credentials fn_gnutls_anon_allocate_client_credentials
# define gnutls_anon_free_client_credentials fn_gnutls_anon_free_client_credentials
# define gnutls_bye fn_gnutls_bye
# define gnutls_certificate_allocate_credentials fn_gnutls_certificate_allocate_credentials
# define gnutls_certificate_free_credentials fn_gnutls_certificate_free_credentials
# define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers
# define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags
# define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file
# define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file
# define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust
# define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file
# define gnutls_certificate_type_get fn_gnutls_certificate_type_get
# define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2
# define gnutls_cipher_get fn_gnutls_cipher_get
# define gnutls_cipher_get_name fn_gnutls_cipher_get_name
# define gnutls_credentials_set fn_gnutls_credentials_set
# define gnutls_deinit fn_gnutls_deinit
# define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits
# define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits
# define gnutls_error_is_fatal fn_gnutls_error_is_fatal
# define gnutls_global_init fn_gnutls_global_init
# define gnutls_global_set_audit_log_function fn_gnutls_global_set_audit_log_function
# define gnutls_global_set_log_function fn_gnutls_global_set_log_function
# define gnutls_global_set_log_level fn_gnutls_global_set_log_level
# define gnutls_handshake fn_gnutls_handshake
# define gnutls_init fn_gnutls_init
# define gnutls_kx_get fn_gnutls_kx_get
# define gnutls_kx_get_name fn_gnutls_kx_get_name
# define gnutls_mac_get fn_gnutls_mac_get
# define gnutls_mac_get_name fn_gnutls_mac_get_name
# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
# define gnutls_protocol_get_name fn_gnutls_protocol_get_name
# define gnutls_protocol_get_version fn_gnutls_protocol_get_version
# define gnutls_record_check_pending fn_gnutls_record_check_pending
# define gnutls_record_recv fn_gnutls_record_recv
# define gnutls_record_send fn_gnutls_record_send
# define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name
# define gnutls_server_name_set fn_gnutls_server_name_set
# define gnutls_sign_get_name fn_gnutls_sign_get_name
# define gnutls_strerror fn_gnutls_strerror
# define gnutls_transport_set_errno fn_gnutls_transport_set_errno
# define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2
# define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function
# define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function
# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time
# define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint
# define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn
# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id
# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
# define gnutls_x509_crt_import fn_gnutls_x509_crt_import
# define gnutls_x509_crt_init fn_gnutls_x509_crt_init
# ifdef HAVE_GNUTLS3
# define gnutls_rnd fn_gnutls_rnd
# define gnutls_mac_list fn_gnutls_mac_list
# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
# define gnutls_digest_list fn_gnutls_digest_list
# define gnutls_digest_get_name fn_gnutls_digest_get_name
# ifdef HAVE_GNUTLS3_CIPHER
# define gnutls_cipher_list fn_gnutls_cipher_list
# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
# define gnutls_cipher_init fn_gnutls_cipher_init
# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv
# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2
# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2
# define gnutls_cipher_deinit fn_gnutls_cipher_deinit
# ifdef HAVE_GNUTLS3_AEAD
# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt
# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt
# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
# endif /* HAVE_GNUTLS3_AEAD */
# ifdef HAVE_GNUTLS3_HMAC
# define gnutls_hmac_init fn_gnutls_hmac_init
# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
# define gnutls_hmac fn_gnutls_hmac
# define gnutls_hmac_deinit fn_gnutls_hmac_deinit
# define gnutls_hmac_output fn_gnutls_hmac_output
# endif /* HAVE_GNUTLS3_HMAC */
# endif /* HAVE_GNUTLS3_CIPHER */
# ifdef HAVE_GNUTLS3_DIGEST
# define gnutls_hash_init fn_gnutls_hash_init
# define gnutls_hash_get_len fn_gnutls_hash_get_len
# define gnutls_hash fn_gnutls_hash
# define gnutls_hash_deinit fn_gnutls_hash_deinit
# define gnutls_hash_output fn_gnutls_hash_output
# endif
# endif /* HAVE_GNUTLS3 */
# define gnutls_alert_get fn_gnutls_alert_get
# define gnutls_alert_get_name fn_gnutls_alert_get_name
# define gnutls_anon_allocate_client_credentials fn_gnutls_anon_allocate_client_credentials
# define gnutls_anon_free_client_credentials fn_gnutls_anon_free_client_credentials
# define gnutls_bye fn_gnutls_bye
# define gnutls_certificate_allocate_credentials fn_gnutls_certificate_allocate_credentials
# define gnutls_certificate_free_credentials fn_gnutls_certificate_free_credentials
# define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers
# define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags
# define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file
# define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file
# define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust
# define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file
# define gnutls_certificate_type_get fn_gnutls_certificate_type_get
# define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2
# define gnutls_cipher_get fn_gnutls_cipher_get
# define gnutls_cipher_get_name fn_gnutls_cipher_get_name
# define gnutls_credentials_set fn_gnutls_credentials_set
# define gnutls_deinit fn_gnutls_deinit
# define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits
# define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits
# define gnutls_error_is_fatal fn_gnutls_error_is_fatal
# define gnutls_global_init fn_gnutls_global_init
# define gnutls_global_set_audit_log_function fn_gnutls_global_set_audit_log_function
# define gnutls_global_set_log_function fn_gnutls_global_set_log_function
# define gnutls_global_set_log_level fn_gnutls_global_set_log_level
# define gnutls_handshake fn_gnutls_handshake
# define gnutls_init fn_gnutls_init
# define gnutls_kx_get fn_gnutls_kx_get
# define gnutls_kx_get_name fn_gnutls_kx_get_name
# define gnutls_mac_get fn_gnutls_mac_get
# define gnutls_mac_get_name fn_gnutls_mac_get_name
# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
# define gnutls_protocol_get_name fn_gnutls_protocol_get_name
# define gnutls_protocol_get_version fn_gnutls_protocol_get_version
# define gnutls_record_check_pending fn_gnutls_record_check_pending
# define gnutls_record_recv fn_gnutls_record_recv
# define gnutls_record_send fn_gnutls_record_send
# define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name
# define gnutls_server_name_set fn_gnutls_server_name_set
# define gnutls_sign_get_name fn_gnutls_sign_get_name
# define gnutls_strerror fn_gnutls_strerror
# define gnutls_transport_set_errno fn_gnutls_transport_set_errno
# define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2
# define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function
# define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function
# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time
# define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint
# define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn
# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id
# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
# define gnutls_x509_crt_import fn_gnutls_x509_crt_import
# define gnutls_x509_crt_init fn_gnutls_x509_crt_init
# ifdef HAVE_GNUTLS3
# define gnutls_rnd fn_gnutls_rnd
# define gnutls_mac_list fn_gnutls_mac_list
# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
# define gnutls_digest_list fn_gnutls_digest_list
# define gnutls_digest_get_name fn_gnutls_digest_get_name
# define gnutls_cipher_list fn_gnutls_cipher_list
# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
# define gnutls_cipher_init fn_gnutls_cipher_init
# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv
# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2
# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2
# define gnutls_cipher_deinit fn_gnutls_cipher_deinit
# ifdef HAVE_GNUTLS_AEAD
# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt
# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt
# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
# endif
# define gnutls_hmac_init fn_gnutls_hmac_init
# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
# define gnutls_hmac fn_gnutls_hmac
# define gnutls_hmac_deinit fn_gnutls_hmac_deinit
# define gnutls_hmac_output fn_gnutls_hmac_output
# define gnutls_hash_init fn_gnutls_hash_init
# define gnutls_hash_get_len fn_gnutls_hash_get_len
# define gnutls_hash fn_gnutls_hash
# define gnutls_hash_deinit fn_gnutls_hash_deinit
# define gnutls_hash_output fn_gnutls_hash_output
# endif /* HAVE_GNUTLS3 */
/* This wrapper is called from fns.c, which doesn't know about the
LOAD_DLL_FN stuff above. */
@ -475,7 +467,7 @@ w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len)
return gnutls_rnd (level, data, len);
}
#endif /* WINDOWSNT */
# endif /* WINDOWSNT */
/* Report memory exhaustion if ERR is an out-of-memory indication. */
@ -489,7 +481,7 @@ check_memory_full (int err)
memory_full (0);
}
#ifdef HAVE_GNUTLS3
# ifdef HAVE_GNUTLS3
/* Log a simple audit message. */
static void
gnutls_audit_log_function (gnutls_session_t session, const char *string)
@ -499,7 +491,7 @@ gnutls_audit_log_function (gnutls_session_t session, const char *string)
message ("gnutls.c: [audit] %s", string);
}
}
#endif
# endif
/* Log a simple message. */
static void
@ -552,7 +544,7 @@ gnutls_try_handshake (struct Lisp_Process *proc)
return ret;
}
#ifndef WINDOWSNT
# ifndef WINDOWSNT
static int
emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
{
@ -560,13 +552,13 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
switch (err)
{
# ifdef _AIX
# ifdef _AIX
/* This is taken from the GnuTLS system_errno function circa 2016;
see <http://savannah.gnu.org/support/?107464>. */
case 0:
errno = EAGAIN;
/* Fall through. */
# endif
# endif
case EINPROGRESS:
case ENOTCONN:
return EAGAIN;
@ -575,7 +567,7 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
return err;
}
}
#endif /* !WINDOWSNT */
# endif /* !WINDOWSNT */
static int
emacs_gnutls_handshake (struct Lisp_Process *proc)
@ -587,7 +579,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
{
#ifdef WINDOWSNT
# ifdef WINDOWSNT
/* On W32 we cannot transfer socket handles between different runtime
libraries, so we tell GnuTLS to use our special push/pull
functions. */
@ -596,7 +588,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
(gnutls_transport_ptr_t) proc);
gnutls_transport_set_push_function (state, &emacs_gnutls_push);
gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
#else
# else
/* This is how GnuTLS takes sockets: as file descriptors passed
in. For an Emacs process socket, infd and outfd are the
same but we use this two-argument version for clarity. */
@ -606,7 +598,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
if (proc->is_non_blocking_client)
gnutls_transport_set_errno_function (state,
emacs_gnutls_nonblock_errno);
#endif
# endif
proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
}
@ -620,13 +612,13 @@ emacs_gnutls_record_check_pending (gnutls_session_t state)
return gnutls_record_check_pending (state);
}
#ifdef WINDOWSNT
# ifdef WINDOWSNT
void
emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
{
gnutls_transport_set_errno (state, err);
}
#endif
# endif
ptrdiff_t
emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
@ -732,10 +724,10 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
/* Mostly ignore "The TLS connection was non-properly
terminated" message which just means that the peer closed the
connection. */
#ifdef HAVE_GNUTLS3
# ifdef HAVE_GNUTLS3
if (err == GNUTLS_E_PREMATURE_TERMINATION)
level = 3;
#endif
# endif
GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
ret = false;
@ -1300,7 +1292,7 @@ gnutls_ip_address_p (char *string)
return true;
}
#if 0
# if 0
/* Deinitialize global GnuTLS state.
See also `gnutls-global-init'. */
static Lisp_Object
@ -1313,7 +1305,7 @@ emacs_gnutls_global_deinit (void)
return gnutls_make_error (GNUTLS_E_SUCCESS);
}
#endif
# endif
static void ATTRIBUTE_FORMAT_PRINTF (2, 3)
boot_error (struct Lisp_Process *p, const char *m, ...)
@ -1585,9 +1577,9 @@ one trustfile (usually a CA bundle). */)
if (TYPE_RANGED_INTEGERP (int, loglevel))
{
gnutls_global_set_log_function (gnutls_log_function);
#ifdef HAVE_GNUTLS3
# ifdef HAVE_GNUTLS3
gnutls_global_set_audit_log_function (gnutls_audit_log_function);
#endif
# endif
gnutls_global_set_log_level (XINT (loglevel));
max_log_level = XINT (loglevel);
XPROCESS (proc)->gnutls_log_level = max_log_level;
@ -1649,8 +1641,7 @@ one trustfile (usually a CA bundle). */)
int file_format = GNUTLS_X509_FMT_PEM;
Lisp_Object tail;
#if GNUTLS_VERSION_MAJOR + \
(GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20) > 3
# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
ret = gnutls_certificate_set_x509_system_trust (x509_cred);
if (ret < GNUTLS_E_SUCCESS)
{
@ -1658,7 +1649,7 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG2i (4, max_log_level,
"setting system trust failed with code ", ret);
}
#endif
# endif
for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
{
@ -1668,12 +1659,12 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
SSDATA (trustfile));
trustfile = ENCODE_FILE (trustfile);
#ifdef WINDOWSNT
# ifdef WINDOWSNT
/* Since GnuTLS doesn't support UTF-8 or UTF-16 encoded
file names on Windows, we need to re-encode the file
name using the current ANSI codepage. */
trustfile = ansi_encode_filename (trustfile);
#endif
# endif
ret = gnutls_certificate_set_x509_trust_file
(x509_cred,
SSDATA (trustfile),
@ -1698,9 +1689,9 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
SSDATA (crlfile));
crlfile = ENCODE_FILE (crlfile);
#ifdef WINDOWSNT
# ifdef WINDOWSNT
crlfile = ansi_encode_filename (crlfile);
#endif
# endif
ret = gnutls_certificate_set_x509_crl_file
(x509_cred, SSDATA (crlfile), file_format);
@ -1727,10 +1718,10 @@ one trustfile (usually a CA bundle). */)
SSDATA (certfile));
keyfile = ENCODE_FILE (keyfile);
certfile = ENCODE_FILE (certfile);
#ifdef WINDOWSNT
# ifdef WINDOWSNT
keyfile = ansi_encode_filename (keyfile);
certfile = ansi_encode_filename (certfile);
#endif
# endif
ret = gnutls_certificate_set_x509_key_file
(x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
@ -1755,10 +1746,10 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG (1, max_log_level, "gnutls_init");
int gnutls_flags = GNUTLS_CLIENT;
#ifdef GNUTLS_NONBLOCK
# ifdef GNUTLS_NONBLOCK
if (XPROCESS (proc)->is_non_blocking_client)
gnutls_flags |= GNUTLS_NONBLOCK;
#endif
# endif
ret = gnutls_init (&state, gnutls_flags);
XPROCESS (proc)->gnutls_state = state;
if (ret < GNUTLS_E_SUCCESS)
@ -1852,7 +1843,6 @@ The alist key is the cipher name. */)
{
Lisp_Object ciphers = Qnil;
#ifdef HAVE_GNUTLS3_CIPHER
const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list ();
for (ptrdiff_t pos = 0; gciphers[pos] != 0; pos++)
{
@ -1886,7 +1876,6 @@ The alist key is the cipher name. */)
ciphers = Fcons (cp, ciphers);
}
#endif
return ciphers;
}
@ -1899,7 +1888,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca,
const char *idata, ptrdiff_t isize,
Lisp_Object aead_auth)
{
#ifdef HAVE_GNUTLS3_AEAD
# ifdef HAVE_GNUTLS_AEAD
const char *desc = encrypting ? "encrypt" : "decrypt";
Lisp_Object actual_iv = make_unibyte_string (vdata, vsize);
@ -1969,10 +1958,10 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca,
SAFE_FREE ();
return list2 (output, actual_iv);
#else
# else
printmax_t print_gca = gca;
error ("GnuTLS AEAD cipher %"pMd" is invalid or not found", print_gca);
#endif
# endif
}
static Lisp_Object
@ -2181,7 +2170,6 @@ name. */)
(void)
{
Lisp_Object mac_algorithms = Qnil;
#ifdef HAVE_GNUTLS3_HMAC
const gnutls_mac_algorithm_t *macs = gnutls_mac_list ();
for (ptrdiff_t pos = 0; macs[pos] != 0; pos++)
{
@ -2204,7 +2192,6 @@ name. */)
make_number (gnutls_mac_get_nonce_size (gma)));
mac_algorithms = Fcons (mp, mac_algorithms);
}
#endif
return mac_algorithms;
}
@ -2218,7 +2205,6 @@ method name. */)
(void)
{
Lisp_Object digest_algorithms = Qnil;
#ifdef HAVE_GNUTLS3_DIGEST
const gnutls_digest_algorithm_t *digests = gnutls_digest_list ();
for (ptrdiff_t pos = 0; digests[pos] != 0; pos++)
{
@ -2236,7 +2222,6 @@ method name. */)
digest_algorithms = Fcons (mp, digest_algorithms);
}
#endif
return digest_algorithms;
}
@ -2423,25 +2408,17 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */)
# ifdef HAVE_GNUTLS3
capabilities = Fcons (intern("gnutls3"), capabilities);
# ifdef HAVE_GNUTLS3_DIGEST
capabilities = Fcons (intern("digests"), capabilities);
# endif
# ifdef HAVE_GNUTLS3_CIPHER
capabilities = Fcons (intern("ciphers"), capabilities);
# ifdef HAVE_GNUTLS3_AEAD
# ifdef HAVE_GNUTLS_AEAD
capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
# endif
# endif
# ifdef HAVE_GNUTLS3_HMAC
capabilities = Fcons (intern("macs"), capabilities);
# endif
# endif /* HAVE_GNUTLS3_CIPHER */
# endif /* HAVE_GNUTLS3 */
#ifdef WINDOWSNT
# ifdef WINDOWSNT
Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
if (CONSP (found))
return XCDR (found);
@ -2452,15 +2429,10 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */)
Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache);
return status;
}
#else /* !WINDOWSNT */
# endif /* WINDOWSNT */
#endif /* HAVE_GNUTLS */
return capabilities;
#endif /* WINDOWSNT */
#else /* !HAVE_GNUTLS */
return Qnil;
#endif /* HAVE_GNUTLS */
}
void

5
src/gnutls.h
View file

@ -23,8 +23,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <gnutls/gnutls.h>
#include <gnutls/x509.h>
#ifdef HAVE_GNUTLS3
#include <gnutls/crypto.h>
#if 0x030000 <= GNUTLS_VERSION_NUMBER
# define HAVE_GNUTLS3
# include <gnutls/crypto.h>
#endif
#include "lisp.h"

3
src/keyboard.c
View file

@ -10168,7 +10168,8 @@ This may include sensitive information such as passwords. */)
file = Fexpand_file_name (file, Qnil);
encfile = ENCODE_FILE (file);
fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
if (fd < 0 && errno == EEXIST && unlink (SSDATA (encfile)) == 0)
if (fd < 0 && errno == EEXIST
&& (unlink (SSDATA (encfile)) == 0 || errno == ENOENT))
fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
dribble = fd < 0 ? 0 : fdopen (fd, "w");
if (dribble == 0)

6
src/lisp.h
View file

@ -4298,13 +4298,15 @@ extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
extern void emacs_perror (char const *);
extern int renameat_noreplace (int, char const *, int, char const *);
extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern void unlock_all_files (void);
/* Defined in filelock.c. */
extern void lock_file (Lisp_Object);
extern void unlock_file (Lisp_Object);
extern void unlock_all_files (void);
extern void unlock_buffer (struct buffer *);
extern void syms_of_filelock (void);
extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
/* Defined in sound.c. */
extern void syms_of_sound (void);

7
src/minibuf.c
View file

@ -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));

8
src/regex.c
View file

@ -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.
*/

2
src/regex.h
View file

@ -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."

20
src/sysdep.c
View file

@ -37,6 +37,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "sysselect.h"
#include "blockinput.h"
#ifdef HAVE_LINUX_FS_H
# include <linux/fs.h>
# include <sys/syscall.h>
#endif
#if defined DARWIN_OS || defined __FreeBSD__
# include <sys/sysctl.h>
#endif
@ -2678,6 +2683,21 @@ set_file_times (int fd, const char *filename,
timespec[1] = mtime;
return fdutimens (fd, filename, timespec);
}
/* Rename directory SRCFD's entry SRC to directory DSTFD's entry DST.
This is like renameat except that it fails if DST already exists,
or if this operation is not supported atomically. Return 0 if
successful, -1 (setting errno) otherwise. */
int
renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst)
{
#if defined SYS_renameat2 && defined RENAME_NOREPLACE
return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE);
#else
errno = ENOSYS;
return -1;
#endif
}
/* Like strsignal, except async-signal-safe, and this function typically
returns a string in the C locale rather than the current locale. */

2
test/lisp/auth-source-tests.el
View file

@ -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")))

273
test/lisp/dired-tests.el
View file

@ -21,7 +21,6 @@
(require 'ert)
(require 'dired)
(require 'nadvice)
(require 'ls-lisp)
(ert-deftest dired-autoload ()
"Tests to see whether dired-x has been autoloaded"
@ -55,10 +54,20 @@
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory dir 'recursive))))
(defvar dired-dwim-target)
(ert-deftest dired-test-bug25609 ()
"Test for http://debbugs.gnu.org/25609 ."
(let* ((from (make-temp-file "foo" 'dir))
;; Make sure we have long file-names in 'from' and 'to', not
;; their 8+3 short aliases, because the latter will confuse
;; Dired commands invoked below.
(from (if (memq system-type '(ms-dos windows-nt))
(file-truename from)
from))
(to (make-temp-file "bar" 'dir))
(to (if (memq system-type '(ms-dos windows-nt))
(file-truename to)
to))
(target (expand-file-name (file-name-nondirectory from) to))
(nested (expand-file-name (file-name-nondirectory from) target))
(dired-dwim-target t)
@ -68,20 +77,30 @@
:override
(lambda (_sym _prompt &rest _args) (setq dired-query t))
'((name . "advice-dired-query")))
(advice-add 'completing-read ; Just return init.
(advice-add 'completing-read ; Don't prompt me: just return init.
:override
(lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap)
init)
'((name . "advice-completing-read")))
(delete-other-windows) ; We don't want to display any other dired buffers.
(push (dired to) buffers)
(push (dired-other-window temporary-file-directory) buffers)
(dired-goto-file from)
(dired-do-copy)
(dired-do-copy); Again.
(unwind-protect
(progn
(should (file-exists-p target))
(should-not (file-exists-p nested)))
(let ((ok-fn
(lambda ()
(let ((win-buffers (mapcar #'window-buffer (window-list))))
(and (memq (car buffers) win-buffers)
(memq (cadr buffers) win-buffers))))))
(dired-goto-file from)
;; Right before `dired-do-copy' call, to reproduce the bug conditions,
;; ensure we have windows displaying the two dired buffers.
(and (funcall ok-fn) (dired-do-copy))
;; Call `dired-do-copy' again: this must overwrite `target'; if the bug
;; still exists, then it creates `nested' instead.
(when (funcall ok-fn)
(dired-do-copy)
(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)
@ -89,10 +108,94 @@
(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 (file-name-as-directory (make-temp-file "test-dir-" t)))
(save-pos (lambda ()
(with-current-buffer (car (dired-buffers-for-dir test-dir))
(dired-save-positions))))
(dired-auto-revert-buffer t) buffers)
;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
;; corresponding long file names exist, otherwise such names trip
;; dired-buffers-for-dir.
(if (eq system-type 'windows-nt)
(setq test-dir (file-truename test-dir)))
(should-not (dired-buffers-for-dir test-dir))
(with-current-buffer (find-file-noselect test-dir)
(make-directory "test-subdir"))
(message "Saved pos: %S" (funcall save-pos))
;; Point must be at end-of-buffer.
(with-current-buffer (car (dired-buffers-for-dir test-dir))
(should (eobp)))
(push (dired test-dir) buffers)
(message "Saved pos: %S" (funcall save-pos))
;; Previous dired call shouldn't create a new buffer: must visit the one
;; created by `find-file-noselect' above.
(should (eq 1 (length (dired-buffers-for-dir test-dir))))
(unwind-protect
(let ((buf (current-buffer))
(pt1 (point))
(test-file (concat (file-name-as-directory "test-subdir")
"test-file")))
(message "Saved pos: %S" (funcall save-pos))
(write-region "Test" nil test-file nil 'silent nil 'excl)
(message "Saved pos: %S" (funcall save-pos))
;; Sanity check: point should now be on the subdirectory.
(should (equal (dired-file-name-at-point)
(concat test-dir (file-name-as-directory "test-subdir"))))
(message "Saved pos: %S" (funcall save-pos))
(push (dired-find-file) buffers)
(let ((pt2 (point))) ; Point is on test-file.
(pop-to-buffer-same-window 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) buffers)
;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
;; corresponding long file names exist, otherwise such names trip
;; string comparisons below.
(if (eq system-type 'windows-nt)
(setq test-dir (file-truename test-dir)))
(with-current-buffer (find-file-noselect test-dir)
(make-directory "test-subdir"))
(push (dired test-dir) buffers)
@ -111,30 +214,44 @@
(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-bug27693 ()
"Test for http://debbugs.gnu.org/27693 ."
(let ((dir (expand-file-name "lisp" source-directory))
(size "")
ls-lisp-use-insert-directory-program buf)
(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
(setq buf (dired (list dir "simple.el" "subr.el"))
size (number-to-string
(file-attribute-size
(file-attributes (dired-get-filename)))))
(search-backward-regexp size nil t)
(should (looking-back "[[:space:]]" (1- (point)))))
(when (buffer-live-p buf) (kill-buffer buf)))))
(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-bug7131 ()
"Test for http://debbugs.gnu.org/7131 ."
@ -152,28 +269,94 @@
(should (cdr (dired-get-marked-files))))
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-deftest dired-test-bug27762 ()
"Test for http://debbugs.gnu.org/27762 ."
:expected-result :failed
(let* ((dir source-directory)
(ert-deftest dired-test-bug27631 ()
"Test for http://debbugs.gnu.org/27631 ."
;; For dired using 'ls' emulation we test for this bug in
;; ls-lisp-tests.el and em-ls-tests.el.
(skip-unless (and (not (featurep 'ls-lisp))
(not (featurep 'eshell))))
(let* ((dir (make-temp-file "bug27631" 'dir))
(dir1 (expand-file-name "dir1" dir))
(dir2 (expand-file-name "dir2" dir))
(default-directory dir)
(files (mapcar (lambda (f) (concat "src/" f))
(directory-files
(expand-file-name "src") nil "\\.*\\.c\\'")))
ls-lisp-use-insert-directory-program buf)
buf)
(unwind-protect
(let ((file1 "src/cygw32.c")
(file2 "src/atimer.c"))
(setq buf (dired (nconc (list dir) files)))
(dired-goto-file (expand-file-name file2 default-directory))
(should-not (looking-at "^ -")) ; Must be 2 spaces not 3.
(setq files (cons file1 (delete file1 files)))
(kill-buffer buf)
(setq buf (dired (nconc (list dir) files)))
(should (looking-at "src"))
(next-line) ; File names must be aligned.
(should (looking-at "src")))
(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))))
(delete-directory dir 'recursive)
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-deftest dired-test-bug27899 ()
"Test for http://debbugs.gnu.org/27899 ."
(let* ((dir (expand-file-name "src" source-directory))
(buf (dired (list dir "cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c")))
(orig dired-hide-details-mode))
(dired-goto-file (expand-file-name "cygw32.c"))
(forward-line 0)
(unwind-protect
(progn
(let ((inhibit-read-only t))
(dired-align-file (point) (point-max)))
(dired-hide-details-mode t)
(dired-move-to-filename)
(should (eq 2 (current-column))))
(dired-hide-details-mode orig))))
(ert-deftest dired-test-bug27968 ()
"Test for http://debbugs.gnu.org/27968 ."
(let* ((top-dir (make-temp-file "top-dir" t))
(subdir (expand-file-name "subdir" top-dir))
(header-len-fn (lambda ()
(save-excursion
(goto-char 1)
(forward-line 1)
(- (point-at-eol) (point)))))
orig-len len diff pos line-nb)
(make-directory subdir 'parents)
(unwind-protect
(with-current-buffer (dired-noselect subdir)
(setq orig-len (funcall header-len-fn)
pos (point)
line-nb (line-number-at-pos))
;; Bug arises when the header line changes its length; this may
;; happen if the used space has changed: for instance, with the
;; creation of additional files.
(make-directory "subdir" t)
(dired-revert)
;; Change the header line.
(save-excursion
(goto-char 1)
(forward-line 1)
(let ((inhibit-read-only t)
(new-header " test-bug27968"))
(delete-region (point) (point-at-eol))
(when (= orig-len (length new-header))
;; Wow lucky guy! I must buy lottery today.
(setq new-header (concat new-header " :-)")))
(insert new-header)))
(setq len (funcall header-len-fn)
diff (- len orig-len))
(should-not (zerop diff)) ; Header length has changed.
;; If diff > 0, then the point moves back.
;; If diff < 0, then the point moves forward.
;; If diff = 0, then the point doesn't move.
;; Sometimes this point movement causes
;; line-nb != (line-number-at-pos pos), so that we get
;; an unexpected file at point if we store buffer points.
;; Note that the line number before/after revert
;; doesn't change.
(should (= line-nb
(line-number-at-pos)
(line-number-at-pos (+ pos diff))))
;; After revert, the point must be in 'subdir' line.
(should (equal "subdir" (dired-get-filename 'local t))))
(delete-directory top-dir t))))
(provide 'dired-tests)
;; dired-tests.el ends here

24
test/lisp/emacs-lisp/cl-generic-tests.el
View file

@ -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

2
test/lisp/emacs-lisp/ert-tests.el
View file

@ -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)

16
test/lisp/emacs-lisp/map-tests.el
View file

@ -64,9 +64,11 @@ Evaluate BODY for each created map.
(should (= 5 (map-elt map 7 5)))))
(ert-deftest test-map-elt-testfn ()
(let ((map (list (cons "a" 1) (cons "b" 2))))
(should-not (map-elt map "a"))
(should (map-elt map "a" nil 'equal))))
(let ((map (list (cons "a" 1) (cons "b" 2)))
;; Make sure to use a non-eq "a", even when compiled.
(noneq-key (string ?a)))
(should-not (map-elt map noneq-key))
(should (map-elt map noneq-key nil 'equal))))
(ert-deftest test-map-elt-with-nil-value ()
(should (null (map-elt '((a . 1)
@ -100,10 +102,12 @@ Evaluate BODY for each created map.
'b))))
(ert-deftest test-map-put-testfn-alist ()
(let ((alist (list (cons "a" 1) (cons "b" 2))))
(map-put alist "a" 3 'equal)
(let ((alist (list (cons "a" 1) (cons "b" 2)))
;; Make sure to use a non-eq "a", even when compiled.
(noneq-key (string ?a)))
(map-put alist noneq-key 3 'equal)
(should-not (cddr alist))
(map-put alist "a" 9)
(map-put alist noneq-key 9)
(should (cddr alist))))
(ert-deftest test-map-put-return-value ()

98
test/lisp/eshell/em-ls-tests.el Normal file
View file

@ -0,0 +1,98 @@
;;; tests/em-ls-tests.el --- em-ls test suite
;; Copyright (C) 2017 Free Software Foundation, Inc.
;; Author: Tino Calancha <tino.calancha@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ert)
(require 'em-ls)
(ert-deftest em-ls-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)
(orig eshell-ls-use-in-dired)
buf)
(unwind-protect
(progn
(customize-set-value 'eshell-ls-use-in-dired t)
(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))))
(customize-set-variable 'eshell-ls-use-in-dired orig)
(delete-directory dir 'recursive)
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-deftest em-ls-test-bug27817 ()
"Test for http://debbugs.gnu.org/27817 ."
(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 em-ls-test-bug27843 ()
"Test for http://debbugs.gnu.org/27843 ."
(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)
(setq buf (dired (list source-directory "lisp")))
(dired-toggle-marks)
(should-not (cdr (dired-get-marked-files))))
(customize-set-variable 'eshell-ls-use-in-dired orig)
(and (buffer-live-p buf) (kill-buffer)))))
(ert-deftest em-ls-test-bug27844 ()
"Test for http://debbugs.gnu.org/27844 ."
(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)
(setq buf (dired (expand-file-name "lisp/*.el" source-directory)))
(dired-toggle-marks)
(should (cdr (dired-get-marked-files)))
(kill-buffer buf)
(setq buf (dired (expand-file-name "lisp/subr.el" source-directory)))
(should (looking-at "subr\\.el")))
(customize-set-variable 'eshell-ls-use-in-dired orig)
(and (buffer-live-p buf) (kill-buffer)))))
(provide 'em-ls-test)
;;; em-ls-tests.el ends here

27
test/lisp/files-tests.el
View file

@ -247,10 +247,11 @@ be $HOME."
(ert-deftest files-tests--file-name-non-special--subprocess ()
"Check that Bug#25949 is fixed."
(skip-unless (executable-find "true"))
(should (eq (let ((default-directory "/:/")) (process-file "true")) 0))
(should (processp (let ((default-directory "/:/"))
(start-file-process "foo" nil "true"))))
(should (eq (let ((default-directory "/:/")) (shell-command "true")) 0)))
(let ((defdir (if (memq system-type '(ms-dos windows-nt)) "/:c:/" "/:/")))
(should (eq (let ((default-directory defdir)) (process-file "true")) 0))
(should (processp (let ((default-directory defdir))
(start-file-process "foo" nil "true"))))
(should (eq (let ((default-directory defdir)) (shell-command "true")) 0))))
(defmacro files-tests--with-advice (symbol where function &rest body)
(declare (indent 3))
@ -313,5 +314,23 @@ be invoked with the right arguments."
`((verify-visited-file-modtime ,buffer-visiting-file)
(verify-visited-file-modtime nil))))))))
(ert-deftest files-tests--insert-directory-wildcard-in-dir-p ()
(let ((alist (list (cons "/home/user/*/.txt" (cons "/home/user/" "*/.txt"))
(cons "/home/user/.txt" nil)
(cons "/home/*/.txt" (cons "/home/" "*/.txt"))
(cons "/home/*/" (cons "/home/" "*/"))
(cons "/*/.txt" (cons "/" "*/.txt"))
;;
(cons "c:/tmp/*/*.txt" (cons "c:/tmp/" "*/*.txt"))
(cons "c:/tmp/*.txt" nil)
(cons "c:/tmp/*/" (cons "c:/tmp/" "*/"))
(cons "c:/*/*.txt" (cons "c:/" "*/*.txt")))))
(dolist (path-res alist)
(should
(equal
(cdr path-res)
(insert-directory-wildcard-in-dir-p (car path-res)))))))
(provide 'files-tests)
;;; files-tests.el ends here

94
test/lisp/ls-lisp-tests.el Normal file
View file

@ -0,0 +1,94 @@
;;; 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)
(require 'ls-lisp)
(ert-deftest ls-lisp-unload ()
"Test for http://debbugs.gnu.org/xxxxx ."
(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))
(require 'ls-lisp))
(ert-deftest ls-lisp-test-bug27762 ()
"Test for http://debbugs.gnu.org/27762 ."
(let* ((dir source-directory)
(default-directory dir)
(files (mapcar (lambda (f) (concat "src/" f))
(directory-files
(expand-file-name "src") nil "\\.*\\.c\\'")))
ls-lisp-use-insert-directory-program buf)
(unwind-protect
(let ((file1 "src/cygw32.c")
(file2 "src/atimer.c"))
(setq buf (dired (nconc (list dir) files)))
(dired-goto-file (expand-file-name file2 default-directory))
(should-not (looking-at "^ -")) ; Must be 2 spaces not 3.
(setq files (cons file1 (delete file1 files)))
(kill-buffer buf)
(setq buf (dired (nconc (list dir) files)))
(should (looking-at "src"))
(next-line) ; File names must be aligned.
(should (looking-at "src")))
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-deftest ls-lisp-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)
ls-lisp-use-insert-directory-program 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))))
(delete-directory dir 'recursive)
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-deftest ls-lisp-test-bug27693 ()
"Test for http://debbugs.gnu.org/27693 ."
(let ((dir (expand-file-name "lisp" source-directory))
(size "")
ls-lisp-use-insert-directory-program buf)
(unwind-protect
(progn
(setq buf (dired (list dir "simple.el" "subr.el"))
size (number-to-string
(file-attribute-size
(file-attributes (dired-get-filename)))))
(search-backward-regexp size nil t)
(should (looking-back "[[:space:]]" (1- (point)))))
(when (buffer-live-p buf) (kill-buffer buf)))))
(provide 'ls-lisp-tests)
;;; ls-lisp-tests.el ends here

159
test/lisp/net/tramp-tests.el
View file

@ -123,9 +123,10 @@ being the result.")
(cdr tramp--test-enabled-checked))
(defun tramp--test-make-temp-name (&optional local quoted)
"Create a temporary file name for test.
If LOCAL is non-nil, a local file is created.
If QUOTED is non-nil, the local part of the file is quoted."
"Return a temporary file name for test.
If LOCAL is non-nil, a local file name is returned.
If QUOTED is non-nil, the local part of the file name is quoted.
The temporary file is not created."
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
@ -2201,6 +2202,110 @@ 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 (tramp--test-sh-p))
;; Since Emacs 26.1.
(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
@ -3005,6 +3110,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
;; Since Emacs 26.1.
(skip-unless (and (fboundp 'connection-local-set-profile-variables)
(fboundp 'connection-local-set-profiles)))
@ -3214,6 +3320,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ert-deftest tramp-test33-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
;; Since Emacs 26.1.
(skip-unless
(and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
@ -3680,6 +3787,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 +3800,16 @@ 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)
(tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0)
(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)
@ -3791,25 +3908,18 @@ process sentinels. They shall not disturb each other."
(count (process-get proc 'bar)))
(tramp--test-message
"Start action %d %s %s" count buf (current-time-string))
;; Regular operation.
;; Regular operation prior process action.
(if (= count 0)
(should-not (file-attributes file))
(should (file-attributes file)))
;; Send string to process.
(tramp--test-message
"Trace 1 action %d %s %s" count buf (current-time-string))
(process-send-string proc (format "%s\n" (buffer-name buf)))
(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 post process action.
(if (= count 2)
(if (= (length buffers) 1)
(tramp--test-instrument-test-case 10
(should-not (file-attributes file)))
(should-not (file-attributes file)))
(should-not (file-attributes file))
(should (file-attributes file)))
(tramp--test-message
"Stop action %d %s %s" count buf (current-time-string))
@ -3820,8 +3930,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,11 +3939,13 @@ 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)))
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))
(ignore-errors (delete-directory tmp-name 'recursive)))))))
(ert-deftest tramp-test37-recursive-load ()
"Check that Tramp does not fail due to recursive load."
@ -3911,8 +4022,8 @@ Since it unloads Tramp, it shall be the last test to run."
(should-not (cl--find-class 'tramp-file-name))
(mapatoms
(lambda (x)
(and (string-match "tramp-file-name" (symbol-name x))
(functionp 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.

43
test/lisp/register-tests.el Normal file
View file

@ -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

Some files were not shown because too many files have changed in this diff Show more