mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-24 19:03:29 +00:00
Code Issues Releases Activity

Merge from origin/emacs-28

Browse Source 
1a1b206a8b Adapt the recent 'num_processors' change to MS-Windows
7cb4637923 Minor fix to clarify a sentence in emacs-lisp-intro
ab60144ea3 ; Pacify recent shorthand unused lexarg warnings.
e9df86004f Make tty-run-terminal-initialization load the .elc file (i...
07edc28bdb Fix ert errors when there's a test that binds `debug-on-er...
96278de8ac New function num-processors
575e626105 Add symbol property 'save-some-buffers-function' (bug#46374)
a3e10af95c Keep reading when typed RET in read-char-from-minibuffer a...
013e3be832 * lisp/userlock.el (ask-user-about-supersession-threat): A...
ae61d7a57d Fix point positioning on mouse clicks with non-zero line-h...
4c7e74c386 Complete shorthands to longhands for symbol-completing tables
c2513c5d0d Add new failing test for bug#51089
1d1e96377c ; * lisp/emacs-lisp/shortdoc.el: Fix typo.
6bf29072e9 Avoid mapping file names through 'substring'
bcce93f04c Update to Org 9.5-46-gb71474
5d408f1a24 Expanded testing of MH-E with multiple MH variants
b497add971 Fix Seccomp filter for newer GNU/Linux systems (Bug#51073).
75d9fbec88 Tramp code cleanup

# Conflicts:
#	etc/NEWS
#	test/lisp/progmodes/elisp-mode-tests.el
This commit is contained in:
Glenn Morris 2021-10-11 08:04:57 -07:00
commit 8aceb37b47
42 changed files with 1082 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
admin/merge-gnulib
View File

@ -39,7 +39,8 @@ GNULIB_MODULES='
free-posix fstatat fsusage fsync futimens
getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog
ieee754-h ignore-value intprops largefile libgmp lstat
manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime
manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime
nproc nstrftime
pathmax pipe2 pselect pthread_sigmask
qcopy-acl readlink readlinkat regex
sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stddef stdio

6
doc/lispintro/emacs-lisp-intro.texi
View File

@ -17456,9 +17456,9 @@ Manual}, for more information.
@findex line-to-top-of-window
@cindex Simple extension in @file{.emacs} file
Here is a simple extension to Emacs that moves the line point is on to
the top of the window. I use this all the time, to make text easier
to read.
Here is a simple extension to Emacs that moves the line that point is
on to the top of the window. I use this all the time, to make text
easier to read.
You can put the following code into a separate file and then load it
from your @file{.emacs} file, or you can include it within your

13
doc/lispref/processes.texi
View File

@ -1047,6 +1047,19 @@ This function returns a list of all processes that have not been deleted.
@end smallexample
@end defun
@defun num-processors &optional query
This function returns the number of processors, a positive integer.
Each usable thread execution unit counts as a processor.
By default, the count includes the number of available processors,
which you can override by setting the
@url{https://www.openmp.org/spec-html/5.1/openmpse59.html,
@env{OMP_NUM_THREADS} environment variable of OpenMP}.
If the optional argument @var{query} is @code{current},
this function ignores @env{OMP_NUM_THREADS};
if @var{query} is @code{all}, this function also counts processors
that are on the system but are not available to the current process.
@end defun
@defun get-process name
This function returns the process named @var{name} (a string), or
@code{nil} if there is none. The argument @var{name} can also be a

71
doc/misc/org.org
View File

@ -1355,9 +1355,8 @@ you, configure the option ~org-table-auto-blank-field~.
Re-align the table, move to the next field. Creates a new row if
necessary.
- {{{kbd(C-c SPC)}}} (~org-table-blank-field~) ::
- {{{kbd(M-x org-table-blank-field)}}} ::
#+kindex: C-c SPC
#+findex: org-table-blank-field
Blank the field at point.
@ -16517,16 +16516,16 @@ keywords.
:END:
#+cindex: citation
As of Org 9.5, a new library =oc.el= provides tooling to handle
citations in Org via "citation processors" that offer some or all of
the following capabilities:
The =oc.el= library provides tooling to handle citations in Org via
"citation processors" that offer some or all of the following
capabilities:
- "activate" :: Fontification, tooltip preview, etc.
- "follow" :: At-point actions on citations via ~org-open-at-point~.
- "insert" :: Add and edit citations via ~org-cite-insert~.
- "export" :: Via different libraries for different target formats.
- activate :: Fontification, tooltip preview, etc.
- follow :: At-point actions on citations via ~org-open-at-point~.
- insert :: Add and edit citations via ~org-cite-insert~.
- export :: Via different libraries for different target formats.
The user can configure these with ~org-cite-active-processor~,
The user can configure these with ~org-cite-activate-processor~,
~org-cite-follow-processor~, ~org-cite-insert-processor~, and
~org-cite-export-processors~ respectively.
@ -16544,8 +16543,10 @@ more "bibliography" keywords.
#+bibliography: "/some/file/with spaces/in its name.bib"
#+end_example
#+kindex: C-c C-x @
#+findex: org-cite-insert
One can then insert and edit citations using ~org-cite-insert~, called
with {{{kbd(M-x org-cite-insert)}}}.
with {{{kbd(C-c C-x @)}}}.
A /citation/ requires one or more citation /key(s)/, elements
identifying a reference in the bibliography.
@ -16554,9 +16555,10 @@ identifying a reference in the bibliography.
- Each key starts with the character =@=.
- Each key can be qualified by a /prefix/ (e.g. "see ") and/or a
/suffix/ (e.g. "p. 123"), giving informations useful or necessary fo
the comprehension of the citation but not included in the reference.
- Each key can be qualified by a /prefix/ (e.g.\nbsp{}"see ") and/or
a /suffix/ (e.g.\nbsp{}"p.\nbsp{}123"), giving informations useful or necessary
fo the comprehension of the citation but not included in the
reference.
- A single citation can cite more than one reference ; the keys are
separated by semicolons ; the formatting of such citation groups is
@ -16564,11 +16566,9 @@ identifying a reference in the bibliography.
- One can also specify a stylistic variation for the citations by
inserting a =/= and a style name between the =cite= keyword and the
colon ; this usially makes sense only for the author-year styles.
colon; this usually makes sense only for the author-year styles.
#+begin_example
[cite/style:common prefix ;prefix @key suffix; ... ; common suffix]
#+end_example
: [cite/style:common prefix ;prefix @key suffix; ... ; common suffix]
The only mandatory elements are:
@ -16583,7 +16583,7 @@ Org currently includes the following export processors:
- Two processors can export to a variety of formats, including =latex=
(and therefore =pdf=), =html=, =odt= and plain (UTF8) text:
- basic :: a basic export processors, well adapted to situations
- basic :: a basic export processor, well adapted to situations
where backward compatibility is not a requirement and formatting
needs are minimal;
@ -16593,45 +16593,42 @@ Org currently includes the following export processors:
- In contrast, two other processors target LaTeX and LaTeX-derived
formats exclusively:
- natbib :: this export processor uses =bibtex=, the historical
- natbib :: this export processor uses BibTeX, the historical
bibliographic processor used with LaTeX, thus allowing the use of
data and style files compatible with this processor (including a
large number of publishers' styles). It uses citation commands
data and style files compatible with this processor (including
a large number of publishers' styles). It uses citation commands
implemented in the LaTeX package =natbib=, allowing more stylistic
variants that LaTeX's =\cite= command.
- biblatex :: this backend allows the use of data and formats
prepared for =biblatex=, an alternate bibliographic processor used
with LaTeX, which overcomes some serious =bibtex= limitations, but
has not (yet?) been widely adopted by publishers.
prepared for BibLaTeX, an alternate bibliographic processor used
with LaTeX, which overcomes some serious BibTeX limitations, but
has not (yet?)\nbsp{}been widely adopted by publishers.
The =#+cite_export:= keyword specifies the export processor and the
The =CITE_EXPORT= keyword specifies the export processor and the
citation (and possibly reference) style(s); for example (all arguments
are optional)
#+begin_example
#+cite_export: basic author author-year
#+end_example
: #+cite_export: basic author author-year
#+texinfo: @noindent
specifies the "basic" export processor with citations inserted as
author's name and references indexed by author's names and year;
#+begin_example
#+cite_export: csl /some/path/to/vancouver-brackets.csl
#+end_example
: #+cite_export: csl /some/path/to/vancouver-brackets.csl
#+texinfo: @noindent
specifies the "csl" processor and CSL style, which in this case
defines numeric citations and numeric references according to the
=Vancouver= specification (as style used in many medical journals),
following a typesetting variation putting citations between brackets;
#+begin_example
#+cite_export: natbib kluwer
#+end_example
: #+cite_export: natbib kluwer
specifies the "natbib" export processor with a label citation style
#+texinfo: @noindent
specifies the =natbib= export processor with a label citation style
conformant to the Harvard style and the specification of the
Wolkers-Kluwer publisher; since it relies on the =bibtex= processor of
Wolkers-Kluwer publisher; since it relies on the ~bibtex~ processor of
your LaTeX installation, it won't export to anything but PDF.
* Working with Source Code

4
etc/NEWS.28
View File

@ -4094,6 +4094,10 @@ Parse a string as a mail address-like string.
** New function 'make-separator-line'.
Make a string appropriate for usage as a visual separator line.
+++
** New function 'num-processors'.
Return the number of processors on the system.
+++
** New function 'object-intervals'.
This function returns a copy of the list of intervals (i.e., text

2
lib-src/seccomp-filter.c
View File

@ -351,6 +351,8 @@ main (int argc, char **argv)
calls at startup time to set up thread-local storage. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address));
RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (prctl),
SCMP_A0_32 (SCMP_CMP_EQ, PR_CAPBSET_READ));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl),
SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS));
RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (arch_prctl),

11
lib/gnulib.mk.in
View File

@ -129,6 +129,7 @@
# minmax \
# mkostemp \
# mktime \
# nproc \
# nstrftime \
# pathmax \
# pipe2 \
@ -2378,6 +2379,16 @@ EXTRA_libgnu_a_SOURCES += mktime.c
endif
## end gnulib module mktime-internal
## begin gnulib module nproc
ifeq (,$(OMIT_GNULIB_MODULE_nproc))
libgnu_a_SOURCES += nproc.c
EXTRA_DIST += nproc.h
endif
## end gnulib module nproc
## begin gnulib module nstrftime
ifeq (,$(OMIT_GNULIB_MODULE_nstrftime))

403
lib/nproc.c Normal file
View File

@ -0,0 +1,403 @@
/* Detect the number of processors.
Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2.1 of the
License, or (at your option) any later version.
This file 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Glen Lenker and Bruno Haible. */
#include <config.h>
#include "nproc.h"
#include <limits.h>
#include <stdlib.h>
#include <unistd.h>
#if HAVE_PTHREAD_GETAFFINITY_NP && 0
# include <pthread.h>
# include <sched.h>
#endif
#if HAVE_SCHED_GETAFFINITY_LIKE_GLIBC || HAVE_SCHED_GETAFFINITY_NP
# include <sched.h>
#endif
#include <sys/types.h>
#if HAVE_SYS_PSTAT_H
# include <sys/pstat.h>
#endif
#if HAVE_SYS_SYSMP_H
# include <sys/sysmp.h>
#endif
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
#if HAVE_SYS_SYSCTL_H && ! defined __GLIBC__
# include <sys/sysctl.h>
#endif
#if defined _WIN32 && ! defined __CYGWIN__
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
#endif
#include "c-ctype.h"
#include "minmax.h"
#define ARRAY_SIZE(a) (sizeof (a) / sizeof ((a)[0]))
/* Return the number of processors available to the current process, based
on a modern system call that returns the "affinity" between the current
process and each CPU. Return 0 if unknown or if such a system call does
not exist. */
static unsigned long
num_processors_via_affinity_mask (void)
{
/* glibc >= 2.3.3 with NPTL and NetBSD 5 have pthread_getaffinity_np,
but with different APIs. Also it requires linking with -lpthread.
Therefore this code is not enabled.
glibc >= 2.3.4 has sched_getaffinity whereas NetBSD 5 has
sched_getaffinity_np. */
#if HAVE_PTHREAD_GETAFFINITY_NP && defined __GLIBC__ && 0
{
cpu_set_t set;
if (pthread_getaffinity_np (pthread_self (), sizeof (set), &set) == 0)
{
unsigned long count;
# ifdef CPU_COUNT
/* glibc >= 2.6 has the CPU_COUNT macro. */
count = CPU_COUNT (&set);
# else
size_t i;
count = 0;
for (i = 0; i < CPU_SETSIZE; i++)
if (CPU_ISSET (i, &set))
count++;
# endif
if (count > 0)
return count;
}
}
#elif HAVE_PTHREAD_GETAFFINITY_NP && defined __NetBSD__ && 0
{
cpuset_t *set;
set = cpuset_create ();
if (set != NULL)
{
unsigned long count = 0;
if (pthread_getaffinity_np (pthread_self (), cpuset_size (set), set)
== 0)
{
cpuid_t i;
for (i = 0;; i++)
{
int ret = cpuset_isset (i, set);
if (ret < 0)
break;
if (ret > 0)
count++;
}
}
cpuset_destroy (set);
if (count > 0)
return count;
}
}
#elif HAVE_SCHED_GETAFFINITY_LIKE_GLIBC /* glibc >= 2.3.4 */
{
cpu_set_t set;
if (sched_getaffinity (0, sizeof (set), &set) == 0)
{
unsigned long count;
# ifdef CPU_COUNT
/* glibc >= 2.6 has the CPU_COUNT macro. */
count = CPU_COUNT (&set);
# else
size_t i;
count = 0;
for (i = 0; i < CPU_SETSIZE; i++)
if (CPU_ISSET (i, &set))
count++;
# endif
if (count > 0)
return count;
}
}
#elif HAVE_SCHED_GETAFFINITY_NP /* NetBSD >= 5 */
{
cpuset_t *set;
set = cpuset_create ();
if (set != NULL)
{
unsigned long count = 0;
if (sched_getaffinity_np (getpid (), cpuset_size (set), set) == 0)
{
cpuid_t i;
for (i = 0;; i++)
{
int ret = cpuset_isset (i, set);
if (ret < 0)
break;
if (ret > 0)
count++;
}
}
cpuset_destroy (set);
if (count > 0)
return count;
}
}
#endif
#if defined _WIN32 && ! defined __CYGWIN__
{ /* This works on native Windows platforms. */
DWORD_PTR process_mask;
DWORD_PTR system_mask;
if (GetProcessAffinityMask (GetCurrentProcess (),
&process_mask, &system_mask))
{
DWORD_PTR mask = process_mask;
unsigned long count = 0;
for (; mask != 0; mask = mask >> 1)
if (mask & 1)
count++;
if (count > 0)
return count;
}
}
#endif
return 0;
}
/* Return the total number of processors. Here QUERY must be one of
NPROC_ALL, NPROC_CURRENT. The result is guaranteed to be at least 1. */
static unsigned long int
num_processors_ignoring_omp (enum nproc_query query)
{
/* On systems with a modern affinity mask system call, we have
sysconf (_SC_NPROCESSORS_CONF)
>= sysconf (_SC_NPROCESSORS_ONLN)
>= num_processors_via_affinity_mask ()
The first number is the number of CPUs configured in the system.
The second number is the number of CPUs available to the scheduler.
The third number is the number of CPUs available to the current process.
Note! On Linux systems with glibc, the first and second number come from
the /sys and /proc file systems (see
glibc/sysdeps/unix/sysv/linux/getsysstats.c).
In some situations these file systems are not mounted, and the sysconf call
returns 1 or 2 (<https://sourceware.org/bugzilla/show_bug.cgi?id=21542>),
which does not reflect the reality. */
if (query == NPROC_CURRENT)
{
/* Try the modern affinity mask system call. */
{
unsigned long nprocs = num_processors_via_affinity_mask ();
if (nprocs > 0)
return nprocs;
}
#if defined _SC_NPROCESSORS_ONLN
{ /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, OSF/1, Solaris,
Cygwin, Haiku. */
long int nprocs = sysconf (_SC_NPROCESSORS_ONLN);
if (nprocs > 0)
return nprocs;
}
#endif
}
else /* query == NPROC_ALL */
{
#if defined _SC_NPROCESSORS_CONF
{ /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, OSF/1, Solaris,
Cygwin, Haiku. */
long int nprocs = sysconf (_SC_NPROCESSORS_CONF);
# if __GLIBC__ >= 2 && defined __linux__
/* On Linux systems with glibc, this information comes from the /sys and
/proc file systems (see glibc/sysdeps/unix/sysv/linux/getsysstats.c).
In some situations these file systems are not mounted, and the
sysconf call returns 1 or 2. But we wish to guarantee that
num_processors (NPROC_ALL) >= num_processors (NPROC_CURRENT). */
if (nprocs == 1 || nprocs == 2)
{
unsigned long nprocs_current = num_processors_via_affinity_mask ();
if (/* nprocs_current > 0 && */ nprocs_current > nprocs)
nprocs = nprocs_current;
}
# endif
if (nprocs > 0)
return nprocs;
}
#endif
}
#if HAVE_PSTAT_GETDYNAMIC
{ /* This works on HP-UX. */
struct pst_dynamic psd;
if (pstat_getdynamic (&psd, sizeof psd, 1, 0) >= 0)
{
/* The field psd_proc_cnt contains the number of active processors.
In newer releases of HP-UX 11, the field psd_max_proc_cnt includes
deactivated processors. */
if (query == NPROC_CURRENT)
{
if (psd.psd_proc_cnt > 0)
return psd.psd_proc_cnt;
}
else
{
if (psd.psd_max_proc_cnt > 0)
return psd.psd_max_proc_cnt;
}
}
}
#endif
#if HAVE_SYSMP && defined MP_NAPROCS && defined MP_NPROCS
{ /* This works on IRIX. */
/* MP_NPROCS yields the number of installed processors.
MP_NAPROCS yields the number of processors available to unprivileged
processes. */
int nprocs =
sysmp (query == NPROC_CURRENT && getuid () != 0
? MP_NAPROCS
: MP_NPROCS);
if (nprocs > 0)
return nprocs;
}
#endif
/* Finally, as fallback, use the APIs that don't distinguish between
NPROC_CURRENT and NPROC_ALL. */
#if HAVE_SYSCTL && ! defined __GLIBC__ && defined HW_NCPU
{ /* This works on Mac OS X, FreeBSD, NetBSD, OpenBSD. */
int nprocs;
size_t len = sizeof (nprocs);
static int const mib[][2] = {
# ifdef HW_NCPUONLINE
{ CTL_HW, HW_NCPUONLINE },
# endif
{ CTL_HW, HW_NCPU }
};
for (int i = 0; i < ARRAY_SIZE (mib); i++)
{
if (sysctl (mib[i], ARRAY_SIZE (mib[i]), &nprocs, &len, NULL, 0) == 0
&& len == sizeof (nprocs)
&& 0 < nprocs)
return nprocs;
}
}
#endif
#if defined _WIN32 && ! defined __CYGWIN__
{ /* This works on native Windows platforms. */
SYSTEM_INFO system_info;
GetSystemInfo (&system_info);
if (0 < system_info.dwNumberOfProcessors)
return system_info.dwNumberOfProcessors;
}
#endif
return 1;
}
/* Parse OMP environment variables without dependence on OMP.
Return 0 for invalid values. */
static unsigned long int
parse_omp_threads (char const* threads)
{
unsigned long int ret = 0;
if (threads == NULL)
return ret;
/* The OpenMP spec says that the value assigned to the environment variables
"may have leading and trailing white space". */
while (*threads != '\0' && c_isspace (*threads))
threads++;
/* Convert it from positive decimal to 'unsigned long'. */
if (c_isdigit (*threads))
{
char *endptr = NULL;
unsigned long int value = strtoul (threads, &endptr, 10);
if (endptr != NULL)
{
while (*endptr != '\0' && c_isspace (*endptr))
endptr++;
if (*endptr == '\0')
return value;
/* Also accept the first value in a nesting level,
since we can't determine the nesting level from env vars. */
else if (*endptr == ',')
return value;
}
}
return ret;
}
unsigned long int
num_processors (enum nproc_query query)
{
unsigned long int omp_env_limit = ULONG_MAX;
if (query == NPROC_CURRENT_OVERRIDABLE)
{
unsigned long int omp_env_threads;
/* Honor the OpenMP environment variables, recognized also by all
programs that are based on OpenMP. */
omp_env_threads = parse_omp_threads (getenv ("OMP_NUM_THREADS"));
omp_env_limit = parse_omp_threads (getenv ("OMP_THREAD_LIMIT"));
if (! omp_env_limit)
omp_env_limit = ULONG_MAX;
if (omp_env_threads)
return MIN (omp_env_threads, omp_env_limit);
query = NPROC_CURRENT;
}
/* Here query is one of NPROC_ALL, NPROC_CURRENT. */
{
unsigned long nprocs = num_processors_ignoring_omp (query);
return MIN (nprocs, omp_env_limit);
}
}

46
lib/nproc.h Normal file
View File

@ -0,0 +1,46 @@
/* Detect the number of processors.
Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2.1 of the
License, or (at your option) any later version.
This file 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Glen Lenker and Bruno Haible. */
/* Allow the use in C++ code. */
#ifdef __cplusplus
extern "C" {
#endif
/* A "processor" in this context means a thread execution unit, that is either
- an execution core in a (possibly multi-core) chip, in a (possibly multi-
chip) module, in a single computer, or
- a thread execution unit inside a core
(hyper-threading, see <https://en.wikipedia.org/wiki/Hyper-threading>).
Which of the two definitions is used, is unspecified. */
enum nproc_query
{
NPROC_ALL, /* total number of processors */
NPROC_CURRENT, /* processors available to the current process */
NPROC_CURRENT_OVERRIDABLE /* likewise, but overridable through the
OMP_NUM_THREADS environment variable */
};
/* Return the total number of processors. The result is guaranteed to
be at least 1. */
extern unsigned long int num_processors (enum nproc_query query);
#ifdef __cplusplus
}
#endif /* C++ */

15
lisp/emacs-lisp/comp.el
View File

@ -3876,26 +3876,13 @@ processes from `comp-async-compilations'"
do (remhash file-name comp-async-compilations))
(hash-table-count comp-async-compilations))
(declare-function w32-get-nproc "w32.c")
(defvar comp-num-cpus nil)
(defun comp-effective-async-max-jobs ()
"Compute the effective number of async jobs."
(if (zerop native-comp-async-jobs-number)
(or comp-num-cpus
(setf comp-num-cpus
;; FIXME: we already have a function to determine
;; the number of processors, see get_native_system_info in w32.c.
;; The result needs to be exported to Lisp.
(max 1 (/ (cond ((eq 'windows-nt system-type)
(w32-get-nproc))
((executable-find "nproc")
(string-to-number
(shell-command-to-string "nproc")))
((eq 'berkeley-unix system-type)
(string-to-number
(shell-command-to-string "sysctl -n hw.ncpu")))
(t 1))
2))))
(max 1 (/ (num-processors) 2))))
native-comp-async-jobs-number))
(defvar comp-last-scanned-async-output nil)

4
lisp/emacs-lisp/ert.el
View File

@ -781,6 +781,10 @@ This mainly sets up debugger-related bindings."
(ert--run-test-debugger test-execution-info
args)))
(debug-on-error t)
;; Don't infloop if the error being called is erroring
;; out, and we have `debug-on-error' bound to nil inside
;; the test.
(backtrace-on-error-noninteractive nil)
(debug-on-quit t)
;; FIXME: Do we need to store the old binding of this
;; and consider it in `ert--run-test-debugger'?

4
lisp/emacs-lisp/shortdoc.el
View File

@ -1319,11 +1319,11 @@ function's documentation in the Info manual")))
(princ value (current-buffer))
(insert "\n"))
(:eg-result
(insert " eg. " double-arrow " ")
(insert " e.g. " double-arrow " ")
(prin1 value (current-buffer))
(insert "\n"))
(:eg-result-string
(insert " eg. " double-arrow " ")
(insert " e.g. " double-arrow " ")
(princ value (current-buffer))
(insert "\n")))))
;; Insert the arglist after doing the evals, in case that's pulled

4
lisp/faces.el
View File

@ -2289,7 +2289,9 @@ If you set `term-file-prefix' to nil, this function does nothing."
(let ((file (locate-library (concat term-file-prefix type))))
(and file
(or (assoc file load-history)
(load (file-name-sans-extension file)
(load (replace-regexp-in-string
"\\.el\\(\\.gz\\)?\\'" ""
file)
t t)))))
type)
;; Next, try to find a matching initialization function, and call it.

12
lisp/files.el
View File

@ -5746,7 +5746,9 @@ This allows you to stop `save-some-buffers' from asking
about certain files that you'd usually rather not save.
This function is called (with no parameters) from the buffer to
be saved."
be saved. When the function's symbol has the property
`save-some-buffers-function', the higher-order function is supposed
to return a predicate used to check buffers."
:group 'auto-save
;; FIXME nil should not be a valid option, let alone the default,
;; eg so that add-function can be used.
@ -5766,6 +5768,7 @@ of the directory that was default during command invocation."
(project-root (project-current)))
default-directory)))
(lambda () (file-in-directory-p default-directory root))))
(put 'save-some-buffers-root 'save-some-buffers-function t)
(defun save-some-buffers (&optional arg pred)
"Save some modified file-visiting buffers. Asks user about each one.
@ -5797,9 +5800,10 @@ change the additional actions you can take on files."
(setq pred save-some-buffers-default-predicate))
;; Allow `pred' to be a function that returns a predicate
;; with lexical bindings in its original environment (bug#46374).
(let ((pred-fun (and (functionp pred) (funcall pred))))
(when (functionp pred-fun)
(setq pred pred-fun)))
(when (and (symbolp pred) (get pred 'save-some-buffers-function))
(let ((pred-fun (and (functionp pred) (funcall pred))))
(when (functionp pred-fun)
(setq pred pred-fun))))
(let* ((switched-buffer nil)
(save-some-buffers--switch-window-callback
(lambda (buffer)

7
lisp/help-fns.el
View File

@ -176,8 +176,11 @@ with the current prefix. The files are chosen according to
completions))
(defun help--symbol-completion-table (string pred action)
(if (and completions-detailed (eq action 'metadata))
'(metadata (affixation-function . help--symbol-completion-table-affixation))
(if (eq action 'metadata)
`(metadata
,@(when completions-detailed
'((affixation-function . help--symbol-completion-table-affixation)))
(category . symbol-help))
(when help-enable-completion-autoload
(let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
(help--load-prefixes prefixes)))

51
lisp/minibuffer.el
View File

@ -943,7 +943,12 @@ When completing \"foo\" the glob \"*f*o*o*\" is used, so that
completion-initials-try-completion completion-initials-all-completions
"Completion of acronyms and initialisms.
E.g. can complete M-x lch to list-command-history
and C-x C-f ~/sew to ~/src/emacs/work."))
and C-x C-f ~/sew to ~/src/emacs/work.")
(shorthand
completion-shorthand-try-completion completion-shorthand-all-completions
"Completion of symbol shorthands setup in `read-symbol-shorthands'.
E.g. can complete \"x-foo\" to \"xavier-foo\" if the shorthand
((\"x-\" . \"xavier-\")) is set up in the buffer of origin."))
"List of available completion styles.
Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS DOC):
where NAME is the name that should be used in `completion-styles',
@ -990,7 +995,8 @@ styles for specific categories, such as files, buffers, etc."
;; e.g. one that does not anchor to bos.
(project-file (styles . (substring)))
(xref-location (styles . (substring)))
(info-menu (styles . (basic substring))))
(info-menu (styles . (basic substring)))
(symbol-help (styles . (basic shorthand substring))))
"Default settings for specific completion categories.
Each entry has the shape (CATEGORY . ALIST) where ALIST is
an association list that can specify properties such as:
@ -1618,6 +1624,9 @@ DONT-CYCLE tells the function not to setup cycling."
(defvar minibuffer--require-match nil
"Value of REQUIRE-MATCH passed to `completing-read'.")
(defvar minibuffer--original-buffer nil
"Buffer that was current when `completing-read' was called.")
(defun minibuffer-complete-and-exit ()
"Exit if the minibuffer contains a valid completion.
Otherwise, try to complete the minibuffer contents. If
@ -4080,6 +4089,40 @@ which is at the core of flex logic. The extra
(let ((newstr (completion-initials-expand string table pred)))
(when newstr
(completion-pcm-try-completion newstr table pred (length newstr)))))
;; Shorthand completion
;;
;; Iff there is a (("x-" . "string-library-")) shorthand setup and
;; string-library-foo is in candidates, complete x-foo to it.
(defun completion-shorthand-try-completion (string table pred point)
"Try completion with `read-symbol-shorthands' of original buffer."
(cl-loop with expanded
for (short . long) in
(with-current-buffer minibuffer--original-buffer
read-symbol-shorthands)
for probe =
(and (> point (length short))
(string-prefix-p short string)
(try-completion (setq expanded
(concat long
(substring
string
(length short))))
table pred))
when probe
do (message "Shorthand expansion")
and return (cons expanded (max (length long)
(+ (- point (length short))
(length long))))))
(defun completion-shorthand-all-completions (_string _table _pred _point)
;; no-op: For now, we don't want shorthands to list all the possible
;; locally active longhands. For the completion categories where
;; this style is active, it could hide other more interesting
;; matches from subsequent styles.
nil)
(defvar completing-read-function #'completing-read-default
"The function called by `completing-read' to do its work.
@ -4111,6 +4154,7 @@ See `completing-read' for the meaning of the arguments."
;; in minibuffer-local-filename-completion-map can
;; override bindings in base-keymap.
base-keymap)))
(buffer (current-buffer))
(result
(minibuffer-with-setup-hook
(lambda ()
@ -4119,7 +4163,8 @@ See `completing-read' for the meaning of the arguments."
;; FIXME: Remove/rename this var, see the next one.
(setq-local minibuffer-completion-confirm
(unless (eq require-match t) require-match))
(setq-local minibuffer--require-match require-match))
(setq-local minibuffer--require-match require-match)
(setq-local minibuffer--original-buffer buffer))
(read-from-minibuffer prompt initial-input keymap
nil hist def inherit-input-method))))
(when (and (equal result "") def)

8
lisp/net/tramp-adb.el
View File

@ -600,7 +600,7 @@ But handle the case, if the \"test\" command is not available."
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(or (eq visit t) (string-or-null-p visit)))
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))
@ -933,8 +933,8 @@ implementation will be used."
(stderr (plist-get args :stderr)))
(unless (stringp name)
(signal 'wrong-type-argument (list #'stringp name)))
(unless (or (null buffer) (bufferp buffer) (stringp buffer))
(signal 'wrong-type-argument (list #'stringp buffer)))
(unless (or (bufferp buffer) (string-or-null-p buffer))
(signal 'wrong-type-argument (list #'bufferp buffer)))
(unless (consp command)
(signal 'wrong-type-argument (list #'consp command)))
(unless (or (null coding)
@ -951,7 +951,7 @@ implementation will be used."
(signal 'wrong-type-argument (list #'functionp filter)))
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(unless (or (bufferp stderr) (string-or-null-p stderr))
(signal 'wrong-type-argument (list #'bufferp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))

8
lisp/net/tramp-sh.el
View File

@ -2771,8 +2771,8 @@ implementation will be used."
(stderr (plist-get args :stderr)))
(unless (stringp name)
(signal 'wrong-type-argument (list #'stringp name)))
(unless (or (null buffer) (bufferp buffer) (stringp buffer))
(signal 'wrong-type-argument (list #'stringp buffer)))
(unless (or (bufferp buffer) (string-or-null-p buffer))
(signal 'wrong-type-argument (list #'bufferp buffer)))
(unless (or (null command) (consp command))
(signal 'wrong-type-argument (list #'consp command)))
(unless (or (null coding)
@ -2789,7 +2789,7 @@ implementation will be used."
(signal 'wrong-type-argument (list #'functionp filter)))
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(unless (or (bufferp stderr) (string-or-null-p stderr))
(signal 'wrong-type-argument (list #'bufferp stderr)))
(when (and (stringp stderr)
(not (tramp-equal-remote default-directory stderr)))
@ -3513,7 +3513,7 @@ implementation will be used."
(tramp-compat-funcall 'unlock-file lockname))
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(or (eq visit t) (string-or-null-p visit)))
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook)))))

2
lisp/net/tramp-smb.el
View File

@ -1658,7 +1658,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(or (eq visit t) (string-or-null-p visit)))
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))

2
lisp/net/tramp-sshfs.el
View File

@ -320,7 +320,7 @@ arguments to pass to the OPERATION."
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(or (eq visit t) (string-or-null-p visit)))
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))

55
lisp/net/tramp.el
View File

@ -1304,7 +1304,7 @@ let-bind this variable."
;; "getconf PATH" yields:
;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin
;; GNU/Linux (Debian, Suse, RHEL, Cygwin, MINGW64): /bin:/usr/bin
;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin
;; IRIX64: /usr/bin
@ -1326,9 +1326,9 @@ tilde expansion, all directory names starting with \"~\" will be ignored.
the command \"getconf PATH\". It is recommended to use this
entry on head of this list, because these are the default
directories for POSIX compatible commands. On remote hosts which
do not offer the getconf command (like cygwin), the value
\"/bin:/usr/bin\" is used instead. This entry is represented in
the list by the special value `tramp-default-remote-path'.
do not offer the getconf command, the value \"/bin:/usr/bin\" is
used instead. This entry is represented in the list by the
special value `tramp-default-remote-path'.
`Private Directories' are the settings of the $PATH environment,
as given in your `~/.profile'. This entry is represented in
@ -4127,8 +4127,8 @@ substitution. SPEC-LIST is a list of char/value pairs used for
(stderr (plist-get args :stderr)))
(unless (stringp name)
(signal 'wrong-type-argument (list #'stringp name)))
(unless (or (null buffer) (bufferp buffer) (stringp buffer))
(signal 'wrong-type-argument (list #'stringp buffer)))
(unless (or (bufferp buffer) (string-or-null-p buffer))
(signal 'wrong-type-argument (list #'bufferp buffer)))
(unless (consp command)
(signal 'wrong-type-argument (list #'consp command)))
(unless (or (null coding)
@ -4564,7 +4564,7 @@ of."
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(or (eq visit t) (string-or-null-p visit)))
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))
@ -4630,9 +4630,8 @@ of."
(let ((user (or (tramp-file-name-user vec)
(with-tramp-connection-property vec "login-as"
(save-window-excursion
(let ((enable-recursive-minibuffers t))
(pop-to-buffer (tramp-get-connection-buffer vec))
(read-string (match-string 0))))))))
(pop-to-buffer (tramp-get-connection-buffer vec))
(read-string (match-string 0)))))))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-message vec 3 "Sending login name `%s'" user)
@ -4642,8 +4641,7 @@ of."
(defun tramp-action-password (proc vec)
"Query the user for a password."
(with-current-buffer (process-buffer proc)
(let ((enable-recursive-minibuffers t)
(case-fold-search t))
(let ((case-fold-search t))
;; Let's check whether a wrong password has been sent already.
;; Sometimes, the process returns a new password request
;; immediately after rejecting the previous (wrong) one.
@ -4674,14 +4672,13 @@ of."
Send \"yes\" to remote process on confirmation, abort otherwise.
See also `tramp-action-yn'."
(save-window-excursion
(let ((enable-recursive-minibuffers t))
(pop-to-buffer (tramp-get-connection-buffer vec))
(unless (yes-or-no-p (match-string 0))
(kill-process proc)
(throw 'tramp-action 'permission-denied))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-send-string vec (concat "yes" tramp-local-end-of-line))))
(pop-to-buffer (tramp-get-connection-buffer vec))
(unless (yes-or-no-p (match-string 0))
(kill-process proc)
(throw 'tramp-action 'permission-denied))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-send-string vec (concat "yes" tramp-local-end-of-line)))
t)
(defun tramp-action-yn (proc vec)
@ -4689,14 +4686,13 @@ See also `tramp-action-yn'."
Send \"y\" to remote process on confirmation, abort otherwise.
See also `tramp-action-yesno'."
(save-window-excursion
(let ((enable-recursive-minibuffers t))
(pop-to-buffer (tramp-get-connection-buffer vec))
(unless (y-or-n-p (match-string 0))
(kill-process proc)
(throw 'tramp-action 'permission-denied))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-send-string vec (concat "y" tramp-local-end-of-line))))
(pop-to-buffer (tramp-get-connection-buffer vec))
(unless (y-or-n-p (match-string 0))
(kill-process proc)
(throw 'tramp-action 'permission-denied))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 6 "\n%s" (buffer-string)))
(tramp-send-string vec (concat "y" tramp-local-end-of-line)))
t)
(defun tramp-action-terminal (_proc vec)
@ -4830,7 +4826,8 @@ performed successfully. Any other value means an error."
(save-restriction
(with-tramp-progress-reporter
proc 3 "Waiting for prompts from remote shell"
(let (exit)
(let ((enable-recursive-minibuffers t)
exit)
(if timeout
(with-timeout (timeout (setq exit 'timeout))
(while (not exit)

13
lisp/org/oc-biblatex.el
View File

@ -165,15 +165,11 @@ INFO is the export state, as a property list."
(org-cite-biblatex--atomic-arguments (list r) info))
(org-cite-get-references citation)
"")
;; According to biblatex manual, left braces or brackets
;; According to BibLaTeX manual, left braces or brackets
;; following a multicite command could be parsed as other
;; arguments. So we look ahead and insert a \relax if
;; needed.
(and (let ((next (org-export-get-next-element citation info)))
(and next
(string-match (rx string-start (or "{" "["))
(org-export-data next info))))
"\\relax"))))
;; arguments. So we stop any further parsing by inserting
;; a \relax unconditionally.
"\\relax")))
(defun org-cite-biblatex--command (citation info base &optional multi no-opt)
"Return biblatex command using BASE name for CITATION object.
@ -314,6 +310,7 @@ to the document, and set styles."
'((("author" "a") ("caps" "c") ("full" "f") ("caps-full" "cf"))
(("locators" "l") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
(("noauthor" "na"))
(("nocite" "n"))
(("text" "t") ("caps" "c"))
(("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))))

52
lisp/org/oc.el
View File

@ -89,7 +89,6 @@
(declare-function org-element-type "org-element" (element))
(declare-function org-export-derived-backend-p "org-export" (backend &rest backends))
(declare-function org-export-get-footnote-definition "org-export" (footnote-reference info))
(declare-function org-export-get-next-element "org-export" (blob info &optional n))
(declare-function org-export-get-previous-element "org-export" (blob info &optional n))
(declare-function org-export-raw-string "org-export" (s))
@ -152,10 +151,10 @@ triplet following the pattern
(NAME BIBLIOGRAPHY-STYLE CITATION-STYLE)
There, NAME is the name of a registered citation processor providing export
functionality, as a symbol. BIBLIOGRAPHY-STYLE (resp. CITATION-STYLE) is the
desired default style to use when printing a bibliography (resp. exporting a
citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and CITATION-STYLE are
optional. NAME is mandatory.
functionality, as a symbol. BIBLIOGRAPHY-STYLE (respectively CITATION-STYLE)
is the desired default style to use when printing a bibliography (respectively
exporting a citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and
CITATION-STYLE are optional. NAME is mandatory.
The export process selects the citation processor associated to the current
export back-end, or the most specific back-end the current one is derived from,
@ -502,8 +501,8 @@ This function assumes S precedes CITATION."
(defun org-cite--move-punct-before (punct citation s info)
"Move punctuation PUNCT before CITATION object.
String S contains PUNCT. The function assumes S follows CITATION.
Parse tree is modified by side-effect."
String S contains PUNCT. INFO is the export state, as a property list.
The function assumes S follows CITATION. Parse tree is modified by side-effect."
(if (equal s punct)
(org-element-extract-element s) ;it would be empty anyway
(org-element-set-element s (substring s (length punct))))
@ -799,9 +798,20 @@ INFO is the export communication channel, as a property list."
;; Do not force entering inline definitions, since
;; `org-element-map' is going to enter it anyway.
((guard (eq 'inline (org-element-property :type datum))))
;; Find definition for current standard
;; footnote reference. Unlike to
;; `org-export-get-footnote-definition', do
;; not cache results as they would contain
;; un-processed citation objects.
(_
(funcall search-cites
(org-export-get-footnote-definition datum info)))))
(let ((label (org-element-property :label datum)))
(funcall
search-cites
(org-element-map data 'footnote-definition
(lambda (d)
(and
(equal label (org-element-property :label d))
(or (org-element-contents d) "")))))))))
info nil 'footnote-definition t))))
(funcall search-cites (plist-get info :parse-tree))
(let ((result (nreverse cites)))
@ -877,13 +887,16 @@ modified by side-effect."
INFO is the export state, as a property list.
Optional argument RULE is the punctuation rule used, as a triplet. When nil,
rule is determined according to `org-cite-note-rules', which see.
Optional argument PUNCT is a list of punctuation marks to be considered.
When nil, it defaults to `org-cite-punctuation-marks'.
Parse tree is modified by side-effect.
Note: when calling both `org-cite-adjust-note' and `org-cite-wrap-citation' on
the same object, call `org-cite-adjust-punctuation' first."
the same object, call `org-cite-adjust-note' first."
(when org-cite-adjust-note-numbers
(pcase-let* ((rule (or rule (org-cite--get-note-rule info)))
(punct-re (regexp-opt (or punct org-cite-punctuation-marks)))
@ -1274,11 +1287,13 @@ by side-effect."
;; Before removing the citation, transfer its `:post-blank'
;; property to the object before, if any.
(org-cite--set-previous-post-blank cite blanks info)
;; We want to be sure any non-note citation is preceded by
;; a space. This is particularly important when using
;; Make sure there is a space between a quotation mark and
;; a citation. This is particularly important when using
;; `adaptive' note rule. See `org-cite-note-rules'.
(unless (org-cite-inside-footnote-p cite t)
(org-cite--set-previous-post-blank cite 1 info))
(let ((previous (org-export-get-previous-element cite info)))
(when (and (org-string-nw-p previous)
(string-suffix-p "\"" previous))
(org-cite--set-previous-post-blank cite 1 info)))
(pcase replacement
;; String.
((pred stringp)
@ -1384,7 +1399,8 @@ ARG is the prefix argument received when calling `org-open-at-point', or nil."
;;; Meta-command for citation insertion (insert capability)
(defun org-cite--allowed-p (context)
"Non-nil when a citation can be inserted at point."
"Non-nil when a citation can be inserted at point.
CONTEXT is the element or object at point, as returned by `org-element-context'."
(let ((type (org-element-type context)))
(cond
;; No citation in attributes, except in parsed ones.
@ -1430,7 +1446,11 @@ ARG is the prefix argument received when calling `org-open-at-point', or nil."
(skip-chars-backward " \r\t\n")
(if (eq (org-element-class context) 'object) (point)
(line-beginning-position 2)))))
;; At the start of a list item is fine, as long as the bullet is unaffected.
;; At the beginning of a footnote definition, right after the
;; label, is OK.
((eq type 'footnote-definition) (looking-at (rx space)))
;; At the start of a list item is fine, as long as the bullet is
;; unaffected.
((eq type 'item)
(> (point) (+ (org-element-property :begin context)
(current-indentation)

86
lisp/org/ol-man.el Normal file
View File

@ -0,0 +1,86 @@
;;; ol-man.el --- Links to man pages -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Maintainer: Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
(require 'ol)
(org-link-set-parameters "man"
:follow #'org-man-open
:export #'org-man-export
:store #'org-man-store-link)
(defcustom org-man-command 'man
"The Emacs command to be used to display a man page."
:group 'org-link
:type '(choice (const man) (const woman)))
(defun org-man-open (path _)
"Visit the manpage on PATH.
PATH should be a topic that can be thrown at the man command.
If PATH contains extra ::STRING which will use `occur' to search
matched strings in man buffer."
(string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path)
(let* ((command (match-string 1 path))
(search (match-string 2 path)))
(funcall org-man-command command)
(when search
(with-current-buffer (concat "*Man " command "*")
(goto-char (point-min))
(search-forward search)))))
(defun org-man-store-link ()
"Store a link to a README file."
(when (memq major-mode '(Man-mode woman-mode))
;; This is a man page, we do make this link
(let* ((page (org-man-get-page-name))
(link (concat "man:" page))
(description (format "Manpage for %s" page)))
(org-link-store-props
:type "man"
:link link
:description description))))
(defun org-man-get-page-name ()
"Extract the page name from the buffer name."
;; This works for both `Man-mode' and `woman-mode'.
(if (string-match " \\(\\S-+\\)\\*" (buffer-name))
(match-string 1 (buffer-name))
(error "Cannot create link to this man page")))
(defun org-man-export (link description format)
"Export a man page link from Org files."
(let ((path (format "http://man.he.net/?topic=%s&section=all" link))
(desc (or description link)))
(cond
((eq format 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
((eq format 'latex) (format "\\href{%s}{%s}" path desc))
((eq format 'texinfo) (format "@uref{%s,%s}" path desc))
((eq format 'ascii) (format "%s (%s)" desc path))
((eq format 'md) (format "[%s](%s)" desc path))
(t path))))
(provide 'ol-man)
;;; ol-man.el ends here

5
lisp/org/org-footnote.el
View File

@ -281,7 +281,10 @@ otherwise."
(save-excursion (goto-char (org-element-property :end context))
(skip-chars-backward " \r\t\n")
(if (eq (org-element-class context) 'object) (point)
(1+ (line-beginning-position 2))))))
(line-beginning-position 2)))))
;; At the beginning of a footnote definition, right after the
;; label, is OK.
((eq type 'footnote-definition) (looking-at (rx space)))
;; Other elements are invalid.
((eq (org-element-class context) 'element) nil)
;; Just before object is fine.

2
lisp/org/org-lint.el
View File

@ -350,7 +350,7 @@ called with one argument, the key used for comparison."
(lambda (datum name)
(goto-char (org-element-property :begin datum))
(re-search-forward
(format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name)))
(format "^[ \t]*#\\+[A-Za-z]+:[ \t]*%s[ \t]*$" (regexp-quote name)))
(match-beginning 0))
(lambda (key) (format "Duplicate NAME \"%s\"" key))))

2
lisp/org/org-version.el
View File

@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made."
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
(let ((org-git-version "release_9.5-30-g10dc9d"))
(let ((org-git-version "release_9.5-46-gb71474"))
org-git-version))
(provide 'org-version)

2
lisp/org/org.el
View File

@ -15362,7 +15362,7 @@ The value is a list, with zero or more of the symbols `effort', `appt',
"Save all Org buffers without user confirmation."
(interactive)
(message "Saving all Org buffers...")
(save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
(save-some-buffers t (lambda () (and (derived-mode-p 'org-mode) t)))
(when (featurep 'org-id) (org-id-locations-save))
(message "Saving all Org buffers... done"))

25
lisp/progmodes/project.el
View File

@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Version: 0.8.0
;; Version: 0.8.1
;; Package-Requires: ((emacs "26.1") (xref "1.0.2"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@ -316,16 +316,21 @@ to find the list of ignores for each directory."
" "
(shell-quote-argument ")"))
"")))
(output (with-output-to-string
(with-current-buffer standard-output
(let ((status
(process-file-shell-command command nil t)))
(unless (zerop status)
(error "File listing failed: %s" (buffer-string))))))))
res)
(with-temp-buffer
(let ((status
(process-file-shell-command command nil t))
(pt (point-min)))
(unless (zerop status)
(error "File listing failed: %s" (buffer-string)))
(goto-char pt)
(while (search-forward "\0" nil t)
(push (buffer-substring-no-properties (1+ pt) (1- (point)))
res)
(setq pt (point)))))
(project--remote-file-names
(mapcar (lambda (s) (concat dfn (substring s 1)))
(sort (split-string output "\0" t)
#'string<)))))
(mapcar (lambda (s) (concat dfn s))
(sort res #'string<)))))
(defun project--remote-file-names (local-files)
"Return LOCAL-FILES as if they were on the system of `default-directory'.

8
lisp/subr.el
View File

@ -3036,6 +3036,7 @@ If there is a natural number at point, use it as default."
(set-keymap-parent map minibuffer-local-map)
(define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char)
(define-key map [remap exit-minibuffer] #'read-char-from-minibuffer-insert-other)
(define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom)
(define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command)
@ -3153,9 +3154,10 @@ There is no need to explicitly add `help-char' to CHARS;
(define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window)
(define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down)
(define-key map [escape] #'abort-recursive-edit)
(dolist (symbol '(quit exit exit-prefix))
(define-key map [remap exit] #'y-or-n-p-insert-other)
(dolist (symbol '(exit-prefix quit))
(define-key map (vector 'remap symbol) #'abort-recursive-edit))
(define-key map [escape] #'abort-recursive-edit)
;; FIXME: try catch-all instead of explicit bindings:
;; (define-key map [remap t] #'y-or-n-p-insert-other)
@ -3219,7 +3221,7 @@ PROMPT is also updated to show `help-char' like \"(y, n or C-h) \",
where `help-char' is automatically bound to `help-form-show'.
No confirmation of the answer is requested; a single character is
enough. RET and SPC also means yes, and DEL means no.
enough. SPC also means yes, and DEL means no.
To be precise, this function translates user input into responses
by consulting the bindings in `query-replace-map'; see the

4
lisp/userlock.el
View File

@ -194,7 +194,9 @@ really edit the buffer? (%s, %s, %s or %s) "
(list "File reverted" filename)))
((eq answer ?n)
(signal 'file-supersession
(list "File changed on disk" filename)))))
(list "File changed on disk" filename)))
((eq answer ?y))
(t (setq answer nil))))
(message
"File on disk now will become a backup file if you save these changes.")
(setq buffer-backed-up nil))))

5
m4/gnulib-comp.m4
View File

@ -139,6 +139,7 @@ AC_DEFUN([gl_EARLY],
# Code from module mktime-internal:
# Code from module multiarch:
# Code from module nocrash:
# Code from module nproc:
# Code from module nstrftime:
# Code from module open:
# Code from module openat-h:
@ -413,6 +414,7 @@ AC_DEFUN([gl_INIT],
fi
gl_TIME_MODULE_INDICATOR([mktime])
gl_MULTIARCH
gl_NPROC
gl_FUNC_GNU_STRFTIME
gl_PATHMAX
gl_FUNC_PIPE2
@ -1221,6 +1223,8 @@ AC_DEFUN([gl_FILE_LIST], [
lib/mkostemp.c
lib/mktime-internal.h
lib/mktime.c
lib/nproc.c
lib/nproc.h
lib/nstrftime.c
lib/open.c
lib/openat-priv.h
@ -1370,6 +1374,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/mode_t.m4
m4/multiarch.m4
m4/nocrash.m4
m4/nproc.m4
m4/nstrftime.m4
m4/off_t.m4
m4/open-cloexec.m4

54
m4/nproc.m4 Normal file
View File

@ -0,0 +1,54 @@
# nproc.m4 serial 5
dnl Copyright (C) 2009-2021 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_NPROC],
[
gl_PREREQ_NPROC
])
# Prerequisites of lib/nproc.c.
AC_DEFUN([gl_PREREQ_NPROC],
[
dnl Persuade glibc <sched.h> to declare CPU_SETSIZE, CPU_ISSET etc.
AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
AC_CHECK_HEADERS([sys/pstat.h sys/sysmp.h sys/param.h],,,
[AC_INCLUDES_DEFAULT])
dnl <sys/sysctl.h> requires <sys/param.h> on OpenBSD 4.0.
AC_CHECK_HEADERS([sys/sysctl.h],,,
[AC_INCLUDES_DEFAULT
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
])
AC_CHECK_FUNCS([sched_getaffinity sched_getaffinity_np \
pstat_getdynamic sysmp sysctl])
dnl Test whether sched_getaffinity has the expected declaration.
dnl glibc 2.3.[0-2]:
dnl int sched_getaffinity (pid_t, unsigned int, unsigned long int *);
dnl glibc 2.3.3:
dnl int sched_getaffinity (pid_t, cpu_set_t *);
dnl glibc >= 2.3.4:
dnl int sched_getaffinity (pid_t, size_t, cpu_set_t *);
if test $ac_cv_func_sched_getaffinity = yes; then
AC_CACHE_CHECK([for glibc compatible sched_getaffinity],
[gl_cv_func_sched_getaffinity3],
[AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM(
[[#include <errno.h>
#include <sched.h>]],
[[sched_getaffinity (0, 0, (cpu_set_t *) 0);]])],
[gl_cv_func_sched_getaffinity3=yes],
[gl_cv_func_sched_getaffinity3=no])
])
if test $gl_cv_func_sched_getaffinity3 = yes; then
AC_DEFINE([HAVE_SCHED_GETAFFINITY_LIKE_GLIBC], [1],
[Define to 1 if sched_getaffinity has a glibc compatible declaration.])
fi
fi
])

1
nt/gnulib-cfg.mk
View File

@ -73,3 +73,4 @@ OMIT_GNULIB_MODULE_lchmod = true
OMIT_GNULIB_MODULE_futimens = true
OMIT_GNULIB_MODULE_utimensat = true
OMIT_GNULIB_MODULE_file-has-acl = true
OMIT_GNULIB_MODULE_nproc = true

18
src/process.c
View File

@ -90,6 +90,7 @@ static struct rlimit nofile_limit;
#include <c-ctype.h>
#include <flexmember.h>
#include <nproc.h>
#include <sig2str.h>
#include <verify.h>
@ -8212,6 +8213,20 @@ integer or floating point values.
return system_process_attributes (pid);
}
DEFUN ("num-processors", Fnum_processors, Snum_processors, 0, 1, 0,
doc: /* Return the number of processors, a positive integer.
Each usable thread execution unit counts as a processor.
By default, count the number of available processors,
overridable via the OMP_NUM_THREADS environment variable.
If optional argument QUERY is `current', ignore OMP_NUM_THREADS.
If QUERY is `all', also count processors not available. */)
(Lisp_Object query)
{
return make_uint (num_processors (EQ (query, Qall) ? NPROC_ALL
: EQ (query, Qcurrent) ? NPROC_CURRENT
: NPROC_CURRENT_OVERRIDABLE));
}
#ifdef subprocesses
/* Arrange to catch SIGCHLD if this hasn't already been arranged.
Invoke this after init_process_emacs, and after glib and/or GNUstep
@ -8472,6 +8487,8 @@ syms_of_process (void)
DEFSYM (Qpcpu, "pcpu");
DEFSYM (Qpmem, "pmem");
DEFSYM (Qargs, "args");
DEFSYM (Qall, "all");
DEFSYM (Qcurrent, "current");
DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
doc: /* Non-nil means delete processes immediately when they exit.
@ -8633,4 +8650,5 @@ amounts of data in one go. */);
defsubr (&Sprocess_inherit_coding_system_flag);
defsubr (&Slist_system_processes);
defsubr (&Sprocess_attributes);
defsubr (&Snum_processors);
}

11
src/w32.c
View File

@ -39,6 +39,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <sys/time.h>
#include <sys/utime.h>
#include <math.h>
#include <nproc.h>
/* Include (most) CRT headers *before* ms-w32.h. */
#include <ms-w32.h>
@ -1962,6 +1963,16 @@ w32_get_nproc (void)
return num_of_processors;
}
/* Emulate Gnulib's 'num_processors'. We cannot use the Gnulib
version because it unconditionally calls APIs that aren't available
on old MS-Windows versions. */
unsigned long
num_processors (enum nproc_query query)
{
/* We ignore QUERY. */
return w32_get_nproc ();
}
static void
sample_system_load (ULONGLONG *idle, ULONGLONG *kernel, ULONGLONG *user)
{

10
src/w32proc.c
View File

@ -3878,14 +3878,6 @@ w32_compare_strings (const char *s1, const char *s2, char *locname,
return val - 2;
}
DEFUN ("w32-get-nproc", Fw32_get_nproc,
Sw32_get_nproc, 0, 0, 0,
doc: /* Return the number of system's processor execution units. */)
(void)
{
return make_fixnum (w32_get_nproc ());
}
void
syms_of_ntproc (void)
@ -3920,8 +3912,6 @@ syms_of_ntproc (void)
defsubr (&Sw32_get_keyboard_layout);
defsubr (&Sw32_set_keyboard_layout);
defsubr (&Sw32_get_nproc);
DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args,
doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
Because Windows does not directly pass argv arrays to child processes,

2
src/xdisp.c
View File

@ -10073,6 +10073,8 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
case MOVE_NEWLINE_OR_CR:
max_current_x = max (it->current_x, max_current_x);
if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
it->override_ascent = -1;
set_iterator_to_next (it, true);
it->continuation_lines_width = 0;
break;

94
test/lisp/mh-e/mh-utils-tests.el
View File

@ -17,6 +17,34 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This test suite runs tests that use and depend on MH programs
;; installed on the system.
;; When running such tests, MH-E can use a particular MH variant
;; installed on the system, or it can use the mocks provided here.
;; (Setup is done by the `with-mh-test-env' macro.)
;; By setting environment variable TEST_MH_PATH, you can select which of
;; the installed MH variants to use, or ignore them all and use mocks.
;; See also the script test-all-mh-variants.sh in this directory.
;; 1. To run these tests against the default MH variant installed on
;; this system:
;; cd ../.. && make lisp/mh-e/mh-utils-tests
;; 2. To run these tests against an MH variant installed in a
;; specific directory, set TEST_MH_PATH, as in this example:
;; cd ../.. && make lisp/mh-e/mh-utils-tests TEST_MH_PATH=/usr/local/nmh/bin
;; 3. To search for and run these tests against all MH variants
;; installed on this system:
;; ./test-all-mh-variants.sh
;; Setting the environment variable TEST_MH_DEBUG or the Lisp variable
;; mh-test-utils-debug-mocks logs access to the file system during the test.
;;; Code:
(require 'ert)
@ -56,34 +84,32 @@
;; Folder names that are used by the following tests.
(defvar mh-test-rel-folder "rela-folder")
(defvar mh-test-abs-folder "/abso-folder")
(defvar mh-test-no-such-folder "/testdir/none"
"Name of a folder that the user does not have.")
(defvar mh-test-no-such-folder "/testdir/none" "A folder that does not exist.")
(defvar mh-test-utils-variants nil
"The value of `mh-variants' used for these tests.
This variable allows setting `mh-variants' to a limited set for targeted
testing. Its value can be different from the normal value when
environment variable TEST_MH_PATH is set. By remembering the value, we
can log the choice only once, which makes the batch log easier to read.")
(defvar mh-test-variant-logged-already nil
"Whether `with-mh-test-env' has written the MH variant to the log.")
(setq mh-test-variant-logged-already nil) ;reset if buffer is re-evaluated
(defvar mh-test-utils-debug-mocks nil
(defvar mh-test-utils-debug-mocks (> (length (getenv "TEST_MH_DEBUG")) 0)
"Whether to log detailed behavior of mock functions.")
(defvar mh-test-call-process-real (symbol-function 'call-process))
(defvar mh-test-file-directory-p-real (symbol-function 'file-directory-p))
;;; This macro wraps tests that touch the file system and/or run programs.
;;; When running such tests, MH-E can use a particular MH variant
;;; installed on the system, or it can use the mocks provided below.
;;; By setting PATH and mh-sys-path, you can select which of the
;;; installed MH variants to use or ignore them all and use mocks.
;;; The macro with-mh-test-env wraps tests that touch the file system
;;; and/or run programs.
(defmacro with-mh-test-env (&rest body)
"Evaluate BODY with a test mail environment.
Functions that touch the file system or run MH programs are either
mocked out or pointed at a test tree. When called from Emacs's batch
testing infrastructure, this will use mocks and thus run on systems
that do not have any MH variant installed. MH-E developers can
install an MH variant and test it interactively."
mocked out or pointed at a test tree. Uses `mh-test-utils-setup' to
select which."
(declare (indent defun))
`(cl-letf ((temp-home-dir nil)
;; make local bindings for things we will modify for test env
@ -93,26 +119,56 @@ install an MH variant and test it interactively."
((symbol-function 'file-directory-p))
;; the test always gets its own sub-folders cache
(mh-sub-folders-cache (make-hash-table :test #'equal))
;; Allow envvar TEST_MH_PATH to control mh-variants.
(mh-variants mh-test-utils-variants)
;; remember the original value
(original-mh-test-variant-logged mh-test-variant-logged-already)
(original-mh-path mh-path)
(original-mh-sys-path mh-sys-path)
(original-exec-path exec-path)
(original-mh-variant-in-use mh-variant-in-use)
(original-mh-progs mh-progs)
(original-mh-lib mh-lib)
(original-mh-lib-progs mh-lib-progs)
(original-mh-envvar (getenv "MH")))
(unwind-protect
(progn
(setq temp-home-dir (mh-test-utils-setup))
,@body)
(unless noninteractive
;; If interactive, forget that we logged the variant and
;; restore any changes TEST_MH_PATH made.
(setq mh-test-variant-logged-already original-mh-test-variant-logged
mh-path original-mh-path
mh-sys-path original-mh-sys-path
exec-path original-exec-path
mh-variant-in-use original-mh-variant-in-use
mh-progs original-mh-progs
mh-lib original-mh-lib
mh-lib-progs original-mh-lib-progs))
(if temp-home-dir (delete-directory temp-home-dir t))
(setenv "MH" original-mh-envvar))))
(defun mh-test-utils-setup ()
"Set dynamically bound variables needed by mock and/or variants.
Call `mh-variant-set' to look through the directories named by
envionment variable `TEST_MH_PATH' (default: `mh-path' and `mh-sys-path')
to find the MH variant to use, if any.
Return the name of the root of the created directory tree, if any."
(when (getenv "TEST_MH_PATH")
;; force mh-variants to use only TEST_MH_PATH
(setq mh-path (split-string (getenv "TEST_MH_PATH") path-separator t)
mh-sys-path nil
exec-path '("/bin" "/usr/bin")))
(unless mh-test-variant-logged-already
(mh-variant-set mh-variant)
(setq mh-test-utils-variants mh-variants)
(setq mh-test-variant-logged-already t))
;; As `call-process'' and `file-directory-p' will be redefined, the
;; native compiler will invoke `call-process' to compile the
;; respective trampolines. To avoid interference with the
;; `call-process' mocking, we build these ahead of time.
(when (native-comp-available-p)
;; As `call-process'' and `file-directory-p' will be redefined, the
;; native compiler will invoke `call-process' to compile the
;; respective trampolines. To avoid interference with the
;; `call-process' mocking, we build these ahead of time.
(mapc #'comp-subr-trampoline-install '(call-process file-directory-p)))
(if mh-variant-in-use
(mh-test-utils-setup-with-variant)

104
test/lisp/mh-e/test-all-mh-variants.sh Executable file
View File

@ -0,0 +1,104 @@
#! /bin/bash
# Run the mh-utils-tests against all MH variants found on this system.
# Copyright (C) 2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
# GNU Emacs is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# GNU Emacs is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Commentary:
# By default runs all tests; test names or Emacs-style regexps may be
# given on the command line to run just those tests.
#
# Option -d turns on Emacs variable mh-test-utils-debug-mocks, which
# causes the tests to output all interactions with the file system.
# If you want to run the tests for only one MH variant, you don't need
# to use this script, because "make" can do it. See the commentary at
# the top of ./mh-utils-tests.el for the recipe.
debug=
if [[ "$1" = -* ]]; then
if [[ "$1" != -d ]]; then
echo "Usage: $(basename "$0") [-d] [test ...]" >&2
exit 2
fi
debug=t
shift
fi
shopt -s extglob
ert_test_list=()
for tst; do
# Guess the type the test spec
case $tst in
*[\[\].*+\\]*) # Regexp: put in string quotes
ert_test_list+=("\"$tst\"")
;;
*) # Lisp expression, keyword, or symbol: use as is
ert_test_list+=("$tst")
;;
esac
done
if [[ ${#ert_test_list[@]} -eq 0 ]]; then
# t means true for all tests, runs everything
ert_test_list=(t)
fi
# This script is 3 directories down in the Emacs source tree.
cd "$(dirname "$0")"
cd ../../..
emacs=(src/emacs --batch -Q)
# MH-E has a good list of directories where an MH variant might be installed,
# so we look in each of those.
read -r -a mh_sys_path \
< <("${emacs[@]}" -l mh-e --eval "(princ mh-sys-path)" | sed 's/[()]//g')
have_done_mocked_variant=false
declare -i tests_total=0 tests_passed=0
for path in "${mh_sys_path[@]}"; do
if [[ ! -x "$path/mhparam" ]]; then
if [[ "$have_done_mocked_variant" = false ]]; then
have_done_mocked_variant=true
else
continue
fi
fi
echo "Testing with PATH $path"
((++tests_total))
# The LD_LIBRARY_PATH setting is needed
# to run locally installed Mailutils.
TEST_MH_PATH=$path TEST_MH_DEBUG=$debug \
LD_LIBRARY_PATH=/usr/local/lib HOME=/nonexistent \
"${emacs[@]}" -l ert \
--eval "(setq load-prefer-newer t)" \
--eval "(load \"$PWD/test/lisp/mh-e/mh-utils-tests\" nil t)" \
--eval "(ert-run-tests-batch-and-exit '(or ${ert_test_list[*]}))" \
&& ((++tests_passed))
done
if (( tests_total == 0 )); then
echo "NO tests run"
exit 1
elif (( tests_total == tests_passed )); then
echo "All tested variants pass: $tests_passed/$tests_total"
else
echo "Tested variants passing: $tests_passed/$tests_total," \
"FAILING: $((tests_total - tests_passed))/$tests_total"
exit 1
fi

24
test/lisp/progmodes/elisp-mode-tests.el
View File

@ -1082,6 +1082,18 @@ evaluation of BODY."
(should (= 84 (funcall (intern-soft "f-test4---"))))
(should (unintern "f-test4---"))))
(ert-deftest elisp-dont-shadow-punctuation-only-symbols ()
:expected-result :failed ; bug#51089
(let* ((shorthanded-form '(- 42 (-foo 42)))
(expected-longhand-form '(- 42 (fooey-foo 42)))
(observed (let ((read-symbol-shorthands
'(("-" . "fooey-"))))
(car (read-from-string
(with-temp-buffer
(print shorthanded-form (current-buffer))
(buffer-string)))))))
(should (equal observed expected-longhand-form))))
(ert-deftest test-indentation ()
(ert-test-erts-file (ert-resource-file "elisp-indents.erts"))
(ert-test-erts-file (ert-resource-file "flet.erts")
@ -1089,5 +1101,17 @@ evaluation of BODY."
(emacs-lisp-mode)
(indent-region (point-min) (point-max)))))
(ert-deftest test-cl-flet-indentation ()
:expected-result :failed ; FIXME: bug#9622
(should (equal
(with-temp-buffer
(emacs-lisp-mode)
(insert "(cl-flet ((bla (x)\n(* x x)))\n(bla 42))")
(indent-region (point-min) (point-max))
(buffer-string))
"(cl-flet ((bla (x)
(* x x)))
(bla 42))")))
(provide 'elisp-mode-tests)
;;; elisp-mode-tests.el ends here

6
test/src/process-tests.el
View File

@ -946,5 +946,11 @@ Return nil if FILENAME doesn't exist."
(when buf
(kill-buffer buf)))))
(ert-deftest process-num-processors ()
"Sanity checks for num-processors."
(should (equal (num-processors) (num-processors)))
(should (integerp (num-processors)))
(should (< 0 (num-processors))))
(provide 'process-tests)
;;; process-tests.el ends here