[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 8aceb37 1/3: Merge from origin/emacs-28
|
From: |
Glenn Morris |
|
Subject: |
master 8aceb37 1/3: Merge from origin/emacs-28 |
|
Date: |
Mon, 11 Oct 2021 11:05:07 -0400 (EDT) |
branch: master
commit 8aceb37b47a8f97fc42caaaf021ac06dc9f67827
Merge: 3952737 1a1b206
Author: Glenn Morris <rgm@gnu.org>
Commit: Glenn Morris <rgm@gnu.org>
Merge from origin/emacs-28
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
---
admin/merge-gnulib | 3 +-
doc/lispintro/emacs-lisp-intro.texi | 6 +-
doc/lispref/processes.texi | 13 ++
doc/misc/org.org | 71 +++---
etc/NEWS.28 | 4 +
lib-src/seccomp-filter.c | 2 +
lib/gnulib.mk.in | 11 +
lib/nproc.c | 403 ++++++++++++++++++++++++++++++++
lib/nproc.h | 46 ++++
lisp/emacs-lisp/comp.el | 15 +-
lisp/emacs-lisp/ert.el | 4 +
lisp/emacs-lisp/shortdoc.el | 4 +-
lisp/faces.el | 4 +-
lisp/files.el | 12 +-
lisp/help-fns.el | 7 +-
lisp/minibuffer.el | 51 +++-
lisp/net/tramp-adb.el | 8 +-
lisp/net/tramp-sh.el | 8 +-
lisp/net/tramp-smb.el | 2 +-
lisp/net/tramp-sshfs.el | 2 +-
lisp/net/tramp.el | 55 +++--
lisp/org/oc-biblatex.el | 13 +-
lisp/org/oc.el | 52 +++--
lisp/org/ol-man.el | 86 +++++++
lisp/org/org-footnote.el | 5 +-
lisp/org/org-lint.el | 2 +-
lisp/org/org-version.el | 2 +-
lisp/org/org.el | 2 +-
lisp/progmodes/project.el | 25 +-
lisp/subr.el | 8 +-
lisp/userlock.el | 4 +-
m4/gnulib-comp.m4 | 5 +
m4/nproc.m4 | 54 +++++
nt/gnulib-cfg.mk | 1 +
src/process.c | 18 ++
src/w32.c | 11 +
src/w32proc.c | 10 -
src/xdisp.c | 2 +
test/lisp/mh-e/mh-utils-tests.el | 94 ++++++--
test/lisp/mh-e/test-all-mh-variants.sh | 104 +++++++++
test/lisp/progmodes/elisp-mode-tests.el | 24 ++
test/src/process-tests.el | 6 +
42 files changed, 1082 insertions(+), 177 deletions(-)
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 886f37e..c9fe3b2 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -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
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index 32c39c7..6ecd552 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -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
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 90c4215..d90097d 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -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
diff --git a/doc/misc/org.org b/doc/misc/org.org
index 7b1277c..5977f09 100644
--- a/doc/misc/org.org
+++ b/doc/misc/org.org
@@ -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
diff --git a/etc/NEWS.28 b/etc/NEWS.28
index 09537d7..791248f 100644
--- a/etc/NEWS.28
+++ b/etc/NEWS.28
@@ -4095,6 +4095,10 @@ Parse a string as a mail address-like string.
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
properties) in the object in question (which must either be a string
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c
index d378e0b..e749605 100644
--- a/lib-src/seccomp-filter.c
+++ b/lib-src/seccomp-filter.c
@@ -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),
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index e9a1a5d..c7c7eb4 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -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))
diff --git a/lib/nproc.c b/lib/nproc.c
new file mode 100644
index 0000000..a9e369d
--- /dev/null
+++ b/lib/nproc.c
@@ -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);
+ }
+}
diff --git a/lib/nproc.h b/lib/nproc.h
new file mode 100644
index 0000000..d7659a5
--- /dev/null
+++ b/lib/nproc.h
@@ -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++ */
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 63d4a74..0052fd0 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -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)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 21b3fbf..5765540 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -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'?
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 51c822d..25bd17b 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -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
diff --git a/lisp/faces.el b/lisp/faces.el
index 089cb88..47f7f3f 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -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.
diff --git a/lisp/files.el b/lisp/files.el
index feec627..5a6a337 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -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)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 6be5cd4..03bbc97 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -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)))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 1e1a6f8..13da7f9 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -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)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index d68d4c7..63ffb2d 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -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)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index dd92f22..8fa53cb 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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)))))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 87f3665..49f049d 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -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))))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 1bd4c5d..a100786 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -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))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index c0f1cb1..a8ae71b 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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)
diff --git a/lisp/org/oc-biblatex.el b/lisp/org/oc-biblatex.el
index f517e39..daf56e7 100644
--- a/lisp/org/oc-biblatex.el
+++ b/lisp/org/oc-biblatex.el
@@ -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"))))
diff --git a/lisp/org/oc.el b/lisp/org/oc.el
index bbf2195..2f74176 100644
--- a/lisp/org/oc.el
+++ b/lisp/org/oc.el
@@ -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)
diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el
new file mode 100644
index 0000000..0d9ac7c
--- /dev/null
+++ b/lisp/org/ol-man.el
@@ -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§ion=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
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index c8c4dae..fcc7579 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -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.
diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el
index 5c64c5a..da5e6ae 100644
--- a/lisp/org/org-lint.el
+++ b/lisp/org/org-lint.el
@@ -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))))
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 5bccbe4..9948008 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -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)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index bc0ea24..c2a37e6 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -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"))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 3eaa789..da7435c 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -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'.
diff --git a/lisp/subr.el b/lisp/subr.el
index cca6d53..fa097b3 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -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
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 87a8b7b..348ccc6 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -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))))
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index a795fe7..e314edc 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -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
diff --git a/m4/nproc.m4 b/m4/nproc.m4
new file mode 100644
index 0000000..887c66b
--- /dev/null
+++ b/m4/nproc.m4
@@ -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
+])
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk
index f1f4c4c..e9f00e7 100644
--- a/nt/gnulib-cfg.mk
+++ b/nt/gnulib-cfg.mk
@@ -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
diff --git a/src/process.c b/src/process.c
index 221d4c7..746cdc0 100644
--- a/src/process.c
+++ b/src/process.c
@@ -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);
}
diff --git a/src/w32.c b/src/w32.c
index 0eb69d4..9fe698d 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -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)
{
diff --git a/src/w32proc.c b/src/w32proc.c
index 702ea12..360f45e 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -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,
diff --git a/src/xdisp.c b/src/xdisp.c
index 9ddf0dd..d8aff50 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -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;
diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el
index bf684db..a10c29f 100644
--- a/test/lisp/mh-e/mh-utils-tests.el
+++ b/test/lisp/mh-e/mh-utils-tests.el
@@ -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)
diff --git a/test/lisp/mh-e/test-all-mh-variants.sh
b/test/lisp/mh-e/test-all-mh-variants.sh
new file mode 100755
index 0000000..e917d81
--- /dev/null
+++ b/test/lisp/mh-e/test-all-mh-variants.sh
@@ -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
diff --git a/test/lisp/progmodes/elisp-mode-tests.el
b/test/lisp/progmodes/elisp-mode-tests.el
index 3856dcd..4d33993 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -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
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index e39f57d..44f3ea2 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -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