aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2021-10-11 08:04:57 -0700
committerGlenn Morris2021-10-11 08:04:57 -0700
commit8aceb37b47a8f97fc42caaaf021ac06dc9f67827 (patch)
tree64e2d073d3980d633a68349b8872b534a5427d59
parent395273773cb7035358cdd7c87f9102af75e39915 (diff)
parent1a1b206a8b33dc597fe2153a59fa30baacf1dcc8 (diff)
downloademacs-8aceb37b47a8f97fc42caaaf021ac06dc9f67827.tar.gz
emacs-8aceb37b47a8f97fc42caaaf021ac06dc9f67827.zip
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
-rwxr-xr-xadmin/merge-gnulib3
-rw-r--r--doc/lispintro/emacs-lisp-intro.texi6
-rw-r--r--doc/lispref/processes.texi13
-rw-r--r--doc/misc/org.org71
-rw-r--r--etc/NEWS.284
-rw-r--r--lib-src/seccomp-filter.c2
-rw-r--r--lib/gnulib.mk.in11
-rw-r--r--lib/nproc.c403
-rw-r--r--lib/nproc.h46
-rw-r--r--lisp/emacs-lisp/comp.el15
-rw-r--r--lisp/emacs-lisp/ert.el4
-rw-r--r--lisp/emacs-lisp/shortdoc.el4
-rw-r--r--lisp/faces.el4
-rw-r--r--lisp/files.el12
-rw-r--r--lisp/help-fns.el7
-rw-r--r--lisp/minibuffer.el51
-rw-r--r--lisp/net/tramp-adb.el8
-rw-r--r--lisp/net/tramp-sh.el8
-rw-r--r--lisp/net/tramp-smb.el2
-rw-r--r--lisp/net/tramp-sshfs.el2
-rw-r--r--lisp/net/tramp.el55
-rw-r--r--lisp/org/oc-biblatex.el13
-rw-r--r--lisp/org/oc.el52
-rw-r--r--lisp/org/ol-man.el86
-rw-r--r--lisp/org/org-footnote.el5
-rw-r--r--lisp/org/org-lint.el2
-rw-r--r--lisp/org/org-version.el2
-rw-r--r--lisp/org/org.el2
-rw-r--r--lisp/progmodes/project.el25
-rw-r--r--lisp/subr.el8
-rw-r--r--lisp/userlock.el4
-rw-r--r--m4/gnulib-comp.m45
-rw-r--r--m4/nproc.m454
-rw-r--r--nt/gnulib-cfg.mk1
-rw-r--r--src/process.c18
-rw-r--r--src/w32.c11
-rw-r--r--src/w32proc.c10
-rw-r--r--src/xdisp.c2
-rw-r--r--test/lisp/mh-e/mh-utils-tests.el94
-rwxr-xr-xtest/lisp/mh-e/test-all-mh-variants.sh104
-rw-r--r--test/lisp/progmodes/elisp-mode-tests.el24
-rw-r--r--test/src/process-tests.el6
42 files changed, 1082 insertions, 177 deletions
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 886f37e28cc..c9fe3b2f95a 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -39,7 +39,8 @@ GNULIB_MODULES='
39 free-posix fstatat fsusage fsync futimens 39 free-posix fstatat fsusage fsync futimens
40 getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog 40 getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog
41 ieee754-h ignore-value intprops largefile libgmp lstat 41 ieee754-h ignore-value intprops largefile libgmp lstat
42 manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime 42 manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime
43 nproc nstrftime
43 pathmax pipe2 pselect pthread_sigmask 44 pathmax pipe2 pselect pthread_sigmask
44 qcopy-acl readlink readlinkat regex 45 qcopy-acl readlink readlinkat regex
45 sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stddef stdio 46 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 32c39c7261b..6ecd552ebb0 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -17456,9 +17456,9 @@ Manual}, for more information.
17456@findex line-to-top-of-window 17456@findex line-to-top-of-window
17457@cindex Simple extension in @file{.emacs} file 17457@cindex Simple extension in @file{.emacs} file
17458 17458
17459Here is a simple extension to Emacs that moves the line point is on to 17459Here is a simple extension to Emacs that moves the line that point is
17460the top of the window. I use this all the time, to make text easier 17460on to the top of the window. I use this all the time, to make text
17461to read. 17461easier to read.
17462 17462
17463You can put the following code into a separate file and then load it 17463You can put the following code into a separate file and then load it
17464from your @file{.emacs} file, or you can include it within your 17464from your @file{.emacs} file, or you can include it within your
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 90c42156372..d90097d0b03 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.
1047@end smallexample 1047@end smallexample
1048@end defun 1048@end defun
1049 1049
1050@defun num-processors &optional query
1051This function returns the number of processors, a positive integer.
1052Each usable thread execution unit counts as a processor.
1053By default, the count includes the number of available processors,
1054which you can override by setting the
1055@url{https://www.openmp.org/spec-html/5.1/openmpse59.html,
1056@env{OMP_NUM_THREADS} environment variable of OpenMP}.
1057If the optional argument @var{query} is @code{current},
1058this function ignores @env{OMP_NUM_THREADS};
1059if @var{query} is @code{all}, this function also counts processors
1060that are on the system but are not available to the current process.
1061@end defun
1062
1050@defun get-process name 1063@defun get-process name
1051This function returns the process named @var{name} (a string), or 1064This function returns the process named @var{name} (a string), or
1052@code{nil} if there is none. The argument @var{name} can also be a 1065@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 7b1277c7a2e..5977f091610 100644
--- a/doc/misc/org.org
+++ b/doc/misc/org.org
@@ -1355,9 +1355,8 @@ you, configure the option ~org-table-auto-blank-field~.
1355 Re-align the table, move to the next field. Creates a new row if 1355 Re-align the table, move to the next field. Creates a new row if
1356 necessary. 1356 necessary.
1357 1357
1358- {{{kbd(C-c SPC)}}} (~org-table-blank-field~) :: 1358- {{{kbd(M-x org-table-blank-field)}}} ::
1359 1359
1360 #+kindex: C-c SPC
1361 #+findex: org-table-blank-field 1360 #+findex: org-table-blank-field
1362 Blank the field at point. 1361 Blank the field at point.
1363 1362
@@ -16517,16 +16516,16 @@ keywords.
16517:END: 16516:END:
16518#+cindex: citation 16517#+cindex: citation
16519 16518
16520As of Org 9.5, a new library =oc.el= provides tooling to handle 16519The =oc.el= library provides tooling to handle citations in Org via
16521citations in Org via "citation processors" that offer some or all of 16520"citation processors" that offer some or all of the following
16522the following capabilities: 16521capabilities:
16523 16522
16524- "activate" :: Fontification, tooltip preview, etc. 16523- activate :: Fontification, tooltip preview, etc.
16525- "follow" :: At-point actions on citations via ~org-open-at-point~. 16524- follow :: At-point actions on citations via ~org-open-at-point~.
16526- "insert" :: Add and edit citations via ~org-cite-insert~. 16525- insert :: Add and edit citations via ~org-cite-insert~.
16527- "export" :: Via different libraries for different target formats. 16526- export :: Via different libraries for different target formats.
16528 16527
16529The user can configure these with ~org-cite-active-processor~, 16528The user can configure these with ~org-cite-activate-processor~,
16530~org-cite-follow-processor~, ~org-cite-insert-processor~, and 16529~org-cite-follow-processor~, ~org-cite-insert-processor~, and
16531~org-cite-export-processors~ respectively. 16530~org-cite-export-processors~ respectively.
16532 16531
@@ -16544,8 +16543,10 @@ more "bibliography" keywords.
16544#+bibliography: "/some/file/with spaces/in its name.bib" 16543#+bibliography: "/some/file/with spaces/in its name.bib"
16545#+end_example 16544#+end_example
16546 16545
16546#+kindex: C-c C-x @
16547#+findex: org-cite-insert
16547One can then insert and edit citations using ~org-cite-insert~, called 16548One can then insert and edit citations using ~org-cite-insert~, called
16548with {{{kbd(M-x org-cite-insert)}}}. 16549with {{{kbd(C-c C-x @)}}}.
16549 16550
16550A /citation/ requires one or more citation /key(s)/, elements 16551A /citation/ requires one or more citation /key(s)/, elements
16551identifying a reference in the bibliography. 16552identifying a reference in the bibliography.
@@ -16554,9 +16555,10 @@ identifying a reference in the bibliography.
16554 16555
16555- Each key starts with the character =@=. 16556- Each key starts with the character =@=.
16556 16557
16557- Each key can be qualified by a /prefix/ (e.g. "see ") and/or a 16558- Each key can be qualified by a /prefix/ (e.g.\nbsp{}"see ") and/or
16558 /suffix/ (e.g. "p. 123"), giving informations useful or necessary fo 16559 a /suffix/ (e.g.\nbsp{}"p.\nbsp{}123"), giving informations useful or necessary
16559 the comprehension of the citation but not included in the reference. 16560 fo the comprehension of the citation but not included in the
16561 reference.
16560 16562
16561- A single citation can cite more than one reference ; the keys are 16563- A single citation can cite more than one reference ; the keys are
16562 separated by semicolons ; the formatting of such citation groups is 16564 separated by semicolons ; the formatting of such citation groups is
@@ -16564,11 +16566,9 @@ identifying a reference in the bibliography.
16564 16566
16565- One can also specify a stylistic variation for the citations by 16567- One can also specify a stylistic variation for the citations by
16566 inserting a =/= and a style name between the =cite= keyword and the 16568 inserting a =/= and a style name between the =cite= keyword and the
16567 colon ; this usially makes sense only for the author-year styles. 16569 colon; this usually makes sense only for the author-year styles.
16568 16570
16569#+begin_example 16571: [cite/style:common prefix ;prefix @key suffix; ... ; common suffix]
16570[cite/style:common prefix ;prefix @key suffix; ... ; common suffix]
16571#+end_example
16572 16572
16573The only mandatory elements are: 16573The only mandatory elements are:
16574 16574
@@ -16583,7 +16583,7 @@ Org currently includes the following export processors:
16583- Two processors can export to a variety of formats, including =latex= 16583- Two processors can export to a variety of formats, including =latex=
16584 (and therefore =pdf=), =html=, =odt= and plain (UTF8) text: 16584 (and therefore =pdf=), =html=, =odt= and plain (UTF8) text:
16585 16585
16586 - basic :: a basic export processors, well adapted to situations 16586 - basic :: a basic export processor, well adapted to situations
16587 where backward compatibility is not a requirement and formatting 16587 where backward compatibility is not a requirement and formatting
16588 needs are minimal; 16588 needs are minimal;
16589 16589
@@ -16593,45 +16593,42 @@ Org currently includes the following export processors:
16593- In contrast, two other processors target LaTeX and LaTeX-derived 16593- In contrast, two other processors target LaTeX and LaTeX-derived
16594 formats exclusively: 16594 formats exclusively:
16595 16595
16596 - natbib :: this export processor uses =bibtex=, the historical 16596 - natbib :: this export processor uses BibTeX, the historical
16597 bibliographic processor used with LaTeX, thus allowing the use of 16597 bibliographic processor used with LaTeX, thus allowing the use of
16598 data and style files compatible with this processor (including a 16598 data and style files compatible with this processor (including
16599 large number of publishers' styles). It uses citation commands 16599 a large number of publishers' styles). It uses citation commands
16600 implemented in the LaTeX package =natbib=, allowing more stylistic 16600 implemented in the LaTeX package =natbib=, allowing more stylistic
16601 variants that LaTeX's =\cite= command. 16601 variants that LaTeX's =\cite= command.
16602 16602
16603 - biblatex :: this backend allows the use of data and formats 16603 - biblatex :: this backend allows the use of data and formats
16604 prepared for =biblatex=, an alternate bibliographic processor used 16604 prepared for BibLaTeX, an alternate bibliographic processor used
16605 with LaTeX, which overcomes some serious =bibtex= limitations, but 16605 with LaTeX, which overcomes some serious BibTeX limitations, but
16606 has not (yet?) been widely adopted by publishers. 16606 has not (yet?)\nbsp{}been widely adopted by publishers.
16607 16607
16608The =#+cite_export:= keyword specifies the export processor and the 16608The =CITE_EXPORT= keyword specifies the export processor and the
16609citation (and possibly reference) style(s); for example (all arguments 16609citation (and possibly reference) style(s); for example (all arguments
16610are optional) 16610are optional)
16611 16611
16612#+begin_example 16612: #+cite_export: basic author author-year
16613#+cite_export: basic author author-year
16614#+end_example
16615 16613
16614#+texinfo: @noindent
16616specifies the "basic" export processor with citations inserted as 16615specifies the "basic" export processor with citations inserted as
16617author's name and references indexed by author's names and year; 16616author's name and references indexed by author's names and year;
16618 16617
16619#+begin_example 16618: #+cite_export: csl /some/path/to/vancouver-brackets.csl
16620#+cite_export: csl /some/path/to/vancouver-brackets.csl
16621#+end_example
16622 16619
16620#+texinfo: @noindent
16623specifies the "csl" processor and CSL style, which in this case 16621specifies the "csl" processor and CSL style, which in this case
16624defines numeric citations and numeric references according to the 16622defines numeric citations and numeric references according to the
16625=Vancouver= specification (as style used in many medical journals), 16623=Vancouver= specification (as style used in many medical journals),
16626following a typesetting variation putting citations between brackets; 16624following a typesetting variation putting citations between brackets;
16627 16625
16628#+begin_example 16626: #+cite_export: natbib kluwer
16629#+cite_export: natbib kluwer
16630#+end_example
16631 16627
16632specifies the "natbib" export processor with a label citation style 16628#+texinfo: @noindent
16629specifies the =natbib= export processor with a label citation style
16633conformant to the Harvard style and the specification of the 16630conformant to the Harvard style and the specification of the
16634Wolkers-Kluwer publisher; since it relies on the =bibtex= processor of 16631Wolkers-Kluwer publisher; since it relies on the ~bibtex~ processor of
16635your LaTeX installation, it won't export to anything but PDF. 16632your LaTeX installation, it won't export to anything but PDF.
16636 16633
16637* Working with Source Code 16634* Working with Source Code
diff --git a/etc/NEWS.28 b/etc/NEWS.28
index 09537d7d313..791248f7dc4 100644
--- a/etc/NEWS.28
+++ b/etc/NEWS.28
@@ -4095,6 +4095,10 @@ Parse a string as a mail address-like string.
4095Make a string appropriate for usage as a visual separator line. 4095Make a string appropriate for usage as a visual separator line.
4096 4096
4097+++ 4097+++
4098** New function 'num-processors'.
4099Return the number of processors on the system.
4100
4101+++
4098** New function 'object-intervals'. 4102** New function 'object-intervals'.
4099This function returns a copy of the list of intervals (i.e., text 4103This function returns a copy of the list of intervals (i.e., text
4100properties) in the object in question (which must either be a string 4104properties) 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 d378e0b0278..e7496053a86 100644
--- a/lib-src/seccomp-filter.c
+++ b/lib-src/seccomp-filter.c
@@ -351,6 +351,8 @@ main (int argc, char **argv)
351 calls at startup time to set up thread-local storage. */ 351 calls at startup time to set up thread-local storage. */
352 RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve)); 352 RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve));
353 RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address)); 353 RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address));
354 RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (prctl),
355 SCMP_A0_32 (SCMP_CMP_EQ, PR_CAPBSET_READ));
354 RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl), 356 RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl),
355 SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS)); 357 SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS));
356 RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (arch_prctl), 358 RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (arch_prctl),
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index e9a1a5dc028..c7c7eb455be 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -129,6 +129,7 @@
129# minmax \ 129# minmax \
130# mkostemp \ 130# mkostemp \
131# mktime \ 131# mktime \
132# nproc \
132# nstrftime \ 133# nstrftime \
133# pathmax \ 134# pathmax \
134# pipe2 \ 135# pipe2 \
@@ -2378,6 +2379,16 @@ EXTRA_libgnu_a_SOURCES += mktime.c
2378endif 2379endif
2379## end gnulib module mktime-internal 2380## end gnulib module mktime-internal
2380 2381
2382## begin gnulib module nproc
2383ifeq (,$(OMIT_GNULIB_MODULE_nproc))
2384
2385libgnu_a_SOURCES += nproc.c
2386
2387EXTRA_DIST += nproc.h
2388
2389endif
2390## end gnulib module nproc
2391
2381## begin gnulib module nstrftime 2392## begin gnulib module nstrftime
2382ifeq (,$(OMIT_GNULIB_MODULE_nstrftime)) 2393ifeq (,$(OMIT_GNULIB_MODULE_nstrftime))
2383 2394
diff --git a/lib/nproc.c b/lib/nproc.c
new file mode 100644
index 00000000000..a9e369dd3f7
--- /dev/null
+++ b/lib/nproc.c
@@ -0,0 +1,403 @@
1/* Detect the number of processors.
2
3 Copyright (C) 2009-2021 Free Software Foundation, Inc.
4
5 This file is free software: you can redistribute it and/or modify
6 it under the terms of the GNU Lesser General Public License as
7 published by the Free Software Foundation; either version 2.1 of the
8 License, or (at your option) any later version.
9
10 This file is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU Lesser General Public License for more details.
14
15 You should have received a copy of the GNU Lesser General Public License
16 along with this program. If not, see <https://www.gnu.org/licenses/>. */
17
18/* Written by Glen Lenker and Bruno Haible. */
19
20#include <config.h>
21#include "nproc.h"
22
23#include <limits.h>
24#include <stdlib.h>
25#include <unistd.h>
26
27#if HAVE_PTHREAD_GETAFFINITY_NP && 0
28# include <pthread.h>
29# include <sched.h>
30#endif
31#if HAVE_SCHED_GETAFFINITY_LIKE_GLIBC || HAVE_SCHED_GETAFFINITY_NP
32# include <sched.h>
33#endif
34
35#include <sys/types.h>
36
37#if HAVE_SYS_PSTAT_H
38# include <sys/pstat.h>
39#endif
40
41#if HAVE_SYS_SYSMP_H
42# include <sys/sysmp.h>
43#endif
44
45#if HAVE_SYS_PARAM_H
46# include <sys/param.h>
47#endif
48
49#if HAVE_SYS_SYSCTL_H && ! defined __GLIBC__
50# include <sys/sysctl.h>
51#endif
52
53#if defined _WIN32 && ! defined __CYGWIN__
54# define WIN32_LEAN_AND_MEAN
55# include <windows.h>
56#endif
57
58#include "c-ctype.h"
59
60#include "minmax.h"
61
62#define ARRAY_SIZE(a) (sizeof (a) / sizeof ((a)[0]))
63
64/* Return the number of processors available to the current process, based
65 on a modern system call that returns the "affinity" between the current
66 process and each CPU. Return 0 if unknown or if such a system call does
67 not exist. */
68static unsigned long
69num_processors_via_affinity_mask (void)
70{
71 /* glibc >= 2.3.3 with NPTL and NetBSD 5 have pthread_getaffinity_np,
72 but with different APIs. Also it requires linking with -lpthread.
73 Therefore this code is not enabled.
74 glibc >= 2.3.4 has sched_getaffinity whereas NetBSD 5 has
75 sched_getaffinity_np. */
76#if HAVE_PTHREAD_GETAFFINITY_NP && defined __GLIBC__ && 0
77 {
78 cpu_set_t set;
79
80 if (pthread_getaffinity_np (pthread_self (), sizeof (set), &set) == 0)
81 {
82 unsigned long count;
83
84# ifdef CPU_COUNT
85 /* glibc >= 2.6 has the CPU_COUNT macro. */
86 count = CPU_COUNT (&set);
87# else
88 size_t i;
89
90 count = 0;
91 for (i = 0; i < CPU_SETSIZE; i++)
92 if (CPU_ISSET (i, &set))
93 count++;
94# endif
95 if (count > 0)
96 return count;
97 }
98 }
99#elif HAVE_PTHREAD_GETAFFINITY_NP && defined __NetBSD__ && 0
100 {
101 cpuset_t *set;
102
103 set = cpuset_create ();
104 if (set != NULL)
105 {
106 unsigned long count = 0;
107
108 if (pthread_getaffinity_np (pthread_self (), cpuset_size (set), set)
109 == 0)
110 {
111 cpuid_t i;
112
113 for (i = 0;; i++)
114 {
115 int ret = cpuset_isset (i, set);
116 if (ret < 0)
117 break;
118 if (ret > 0)
119 count++;
120 }
121 }
122 cpuset_destroy (set);
123 if (count > 0)
124 return count;
125 }
126 }
127#elif HAVE_SCHED_GETAFFINITY_LIKE_GLIBC /* glibc >= 2.3.4 */
128 {
129 cpu_set_t set;
130
131 if (sched_getaffinity (0, sizeof (set), &set) == 0)
132 {
133 unsigned long count;
134
135# ifdef CPU_COUNT
136 /* glibc >= 2.6 has the CPU_COUNT macro. */
137 count = CPU_COUNT (&set);
138# else
139 size_t i;
140
141 count = 0;
142 for (i = 0; i < CPU_SETSIZE; i++)
143 if (CPU_ISSET (i, &set))
144 count++;
145# endif
146 if (count > 0)
147 return count;
148 }
149 }
150#elif HAVE_SCHED_GETAFFINITY_NP /* NetBSD >= 5 */
151 {
152 cpuset_t *set;
153
154 set = cpuset_create ();
155 if (set != NULL)
156 {
157 unsigned long count = 0;
158
159 if (sched_getaffinity_np (getpid (), cpuset_size (set), set) == 0)
160 {
161 cpuid_t i;
162
163 for (i = 0;; i++)
164 {
165 int ret = cpuset_isset (i, set);
166 if (ret < 0)
167 break;
168 if (ret > 0)
169 count++;
170 }
171 }
172 cpuset_destroy (set);
173 if (count > 0)
174 return count;
175 }
176 }
177#endif
178
179#if defined _WIN32 && ! defined __CYGWIN__
180 { /* This works on native Windows platforms. */
181 DWORD_PTR process_mask;
182 DWORD_PTR system_mask;
183
184 if (GetProcessAffinityMask (GetCurrentProcess (),
185 &process_mask, &system_mask))
186 {
187 DWORD_PTR mask = process_mask;
188 unsigned long count = 0;
189
190 for (; mask != 0; mask = mask >> 1)
191 if (mask & 1)
192 count++;
193 if (count > 0)
194 return count;
195 }
196 }
197#endif
198
199 return 0;
200}
201
202
203/* Return the total number of processors. Here QUERY must be one of
204 NPROC_ALL, NPROC_CURRENT. The result is guaranteed to be at least 1. */
205static unsigned long int
206num_processors_ignoring_omp (enum nproc_query query)
207{
208 /* On systems with a modern affinity mask system call, we have
209 sysconf (_SC_NPROCESSORS_CONF)
210 >= sysconf (_SC_NPROCESSORS_ONLN)
211 >= num_processors_via_affinity_mask ()
212 The first number is the number of CPUs configured in the system.
213 The second number is the number of CPUs available to the scheduler.
214 The third number is the number of CPUs available to the current process.
215
216 Note! On Linux systems with glibc, the first and second number come from
217 the /sys and /proc file systems (see
218 glibc/sysdeps/unix/sysv/linux/getsysstats.c).
219 In some situations these file systems are not mounted, and the sysconf call
220 returns 1 or 2 (<https://sourceware.org/bugzilla/show_bug.cgi?id=21542>),
221 which does not reflect the reality. */
222
223 if (query == NPROC_CURRENT)
224 {
225 /* Try the modern affinity mask system call. */
226 {
227 unsigned long nprocs = num_processors_via_affinity_mask ();
228
229 if (nprocs > 0)
230 return nprocs;
231 }
232
233#if defined _SC_NPROCESSORS_ONLN
234 { /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, OSF/1, Solaris,
235 Cygwin, Haiku. */
236 long int nprocs = sysconf (_SC_NPROCESSORS_ONLN);
237 if (nprocs > 0)
238 return nprocs;
239 }
240#endif
241 }
242 else /* query == NPROC_ALL */
243 {
244#if defined _SC_NPROCESSORS_CONF
245 { /* This works on glibc, Mac OS X 10.5, FreeBSD, AIX, OSF/1, Solaris,
246 Cygwin, Haiku. */
247 long int nprocs = sysconf (_SC_NPROCESSORS_CONF);
248
249# if __GLIBC__ >= 2 && defined __linux__
250 /* On Linux systems with glibc, this information comes from the /sys and
251 /proc file systems (see glibc/sysdeps/unix/sysv/linux/getsysstats.c).
252 In some situations these file systems are not mounted, and the
253 sysconf call returns 1 or 2. But we wish to guarantee that
254 num_processors (NPROC_ALL) >= num_processors (NPROC_CURRENT). */
255 if (nprocs == 1 || nprocs == 2)
256 {
257 unsigned long nprocs_current = num_processors_via_affinity_mask ();
258
259 if (/* nprocs_current > 0 && */ nprocs_current > nprocs)
260 nprocs = nprocs_current;
261 }
262# endif
263
264 if (nprocs > 0)
265 return nprocs;
266 }
267#endif
268 }
269
270#if HAVE_PSTAT_GETDYNAMIC
271 { /* This works on HP-UX. */
272 struct pst_dynamic psd;
273 if (pstat_getdynamic (&psd, sizeof psd, 1, 0) >= 0)
274 {
275 /* The field psd_proc_cnt contains the number of active processors.
276 In newer releases of HP-UX 11, the field psd_max_proc_cnt includes
277 deactivated processors. */
278 if (query == NPROC_CURRENT)
279 {
280 if (psd.psd_proc_cnt > 0)
281 return psd.psd_proc_cnt;
282 }
283 else
284 {
285 if (psd.psd_max_proc_cnt > 0)
286 return psd.psd_max_proc_cnt;
287 }
288 }
289 }
290#endif
291
292#if HAVE_SYSMP && defined MP_NAPROCS && defined MP_NPROCS
293 { /* This works on IRIX. */
294 /* MP_NPROCS yields the number of installed processors.
295 MP_NAPROCS yields the number of processors available to unprivileged
296 processes. */
297 int nprocs =
298 sysmp (query == NPROC_CURRENT && getuid () != 0
299 ? MP_NAPROCS
300 : MP_NPROCS);
301 if (nprocs > 0)
302 return nprocs;
303 }
304#endif
305
306 /* Finally, as fallback, use the APIs that don't distinguish between
307 NPROC_CURRENT and NPROC_ALL. */
308
309#if HAVE_SYSCTL && ! defined __GLIBC__ && defined HW_NCPU
310 { /* This works on Mac OS X, FreeBSD, NetBSD, OpenBSD. */
311 int nprocs;
312 size_t len = sizeof (nprocs);
313 static int const mib[][2] = {
314# ifdef HW_NCPUONLINE
315 { CTL_HW, HW_NCPUONLINE },
316# endif
317 { CTL_HW, HW_NCPU }
318 };
319 for (int i = 0; i < ARRAY_SIZE (mib); i++)
320 {
321 if (sysctl (mib[i], ARRAY_SIZE (mib[i]), &nprocs, &len, NULL, 0) == 0
322 && len == sizeof (nprocs)
323 && 0 < nprocs)
324 return nprocs;
325 }
326 }
327#endif
328
329#if defined _WIN32 && ! defined __CYGWIN__
330 { /* This works on native Windows platforms. */
331 SYSTEM_INFO system_info;
332 GetSystemInfo (&system_info);
333 if (0 < system_info.dwNumberOfProcessors)
334 return system_info.dwNumberOfProcessors;
335 }
336#endif
337
338 return 1;
339}
340
341/* Parse OMP environment variables without dependence on OMP.
342 Return 0 for invalid values. */
343static unsigned long int
344parse_omp_threads (char const* threads)
345{
346 unsigned long int ret = 0;
347
348 if (threads == NULL)
349 return ret;
350
351 /* The OpenMP spec says that the value assigned to the environment variables
352 "may have leading and trailing white space". */
353 while (*threads != '\0' && c_isspace (*threads))
354 threads++;
355
356 /* Convert it from positive decimal to 'unsigned long'. */
357 if (c_isdigit (*threads))
358 {
359 char *endptr = NULL;
360 unsigned long int value = strtoul (threads, &endptr, 10);
361
362 if (endptr != NULL)
363 {
364 while (*endptr != '\0' && c_isspace (*endptr))
365 endptr++;
366 if (*endptr == '\0')
367 return value;
368 /* Also accept the first value in a nesting level,
369 since we can't determine the nesting level from env vars. */
370 else if (*endptr == ',')
371 return value;
372 }
373 }
374
375 return ret;
376}
377
378unsigned long int
379num_processors (enum nproc_query query)
380{
381 unsigned long int omp_env_limit = ULONG_MAX;
382
383 if (query == NPROC_CURRENT_OVERRIDABLE)
384 {
385 unsigned long int omp_env_threads;
386 /* Honor the OpenMP environment variables, recognized also by all
387 programs that are based on OpenMP. */
388 omp_env_threads = parse_omp_threads (getenv ("OMP_NUM_THREADS"));
389 omp_env_limit = parse_omp_threads (getenv ("OMP_THREAD_LIMIT"));
390 if (! omp_env_limit)
391 omp_env_limit = ULONG_MAX;
392
393 if (omp_env_threads)
394 return MIN (omp_env_threads, omp_env_limit);
395
396 query = NPROC_CURRENT;
397 }
398 /* Here query is one of NPROC_ALL, NPROC_CURRENT. */
399 {
400 unsigned long nprocs = num_processors_ignoring_omp (query);
401 return MIN (nprocs, omp_env_limit);
402 }
403}
diff --git a/lib/nproc.h b/lib/nproc.h
new file mode 100644
index 00000000000..d7659a5cad3
--- /dev/null
+++ b/lib/nproc.h
@@ -0,0 +1,46 @@
1/* Detect the number of processors.
2
3 Copyright (C) 2009-2021 Free Software Foundation, Inc.
4
5 This file is free software: you can redistribute it and/or modify
6 it under the terms of the GNU Lesser General Public License as
7 published by the Free Software Foundation; either version 2.1 of the
8 License, or (at your option) any later version.
9
10 This file is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU Lesser General Public License for more details.
14
15 You should have received a copy of the GNU Lesser General Public License
16 along with this program. If not, see <https://www.gnu.org/licenses/>. */
17
18/* Written by Glen Lenker and Bruno Haible. */
19
20/* Allow the use in C++ code. */
21#ifdef __cplusplus
22extern "C" {
23#endif
24
25/* A "processor" in this context means a thread execution unit, that is either
26 - an execution core in a (possibly multi-core) chip, in a (possibly multi-
27 chip) module, in a single computer, or
28 - a thread execution unit inside a core
29 (hyper-threading, see <https://en.wikipedia.org/wiki/Hyper-threading>).
30 Which of the two definitions is used, is unspecified. */
31
32enum nproc_query
33{
34 NPROC_ALL, /* total number of processors */
35 NPROC_CURRENT, /* processors available to the current process */
36 NPROC_CURRENT_OVERRIDABLE /* likewise, but overridable through the
37 OMP_NUM_THREADS environment variable */
38};
39
40/* Return the total number of processors. The result is guaranteed to
41 be at least 1. */
42extern unsigned long int num_processors (enum nproc_query query);
43
44#ifdef __cplusplus
45}
46#endif /* C++ */
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 63d4a74b546..0052fd0f8db 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -3876,26 +3876,13 @@ processes from `comp-async-compilations'"
3876 do (remhash file-name comp-async-compilations)) 3876 do (remhash file-name comp-async-compilations))
3877 (hash-table-count comp-async-compilations)) 3877 (hash-table-count comp-async-compilations))
3878 3878
3879(declare-function w32-get-nproc "w32.c")
3880(defvar comp-num-cpus nil) 3879(defvar comp-num-cpus nil)
3881(defun comp-effective-async-max-jobs () 3880(defun comp-effective-async-max-jobs ()
3882 "Compute the effective number of async jobs." 3881 "Compute the effective number of async jobs."
3883 (if (zerop native-comp-async-jobs-number) 3882 (if (zerop native-comp-async-jobs-number)
3884 (or comp-num-cpus 3883 (or comp-num-cpus
3885 (setf comp-num-cpus 3884 (setf comp-num-cpus
3886 ;; FIXME: we already have a function to determine 3885 (max 1 (/ (num-processors) 2))))
3887 ;; the number of processors, see get_native_system_info in w32.c.
3888 ;; The result needs to be exported to Lisp.
3889 (max 1 (/ (cond ((eq 'windows-nt system-type)
3890 (w32-get-nproc))
3891 ((executable-find "nproc")
3892 (string-to-number
3893 (shell-command-to-string "nproc")))
3894 ((eq 'berkeley-unix system-type)
3895 (string-to-number
3896 (shell-command-to-string "sysctl -n hw.ncpu")))
3897 (t 1))
3898 2))))
3899 native-comp-async-jobs-number)) 3886 native-comp-async-jobs-number))
3900 3887
3901(defvar comp-last-scanned-async-output nil) 3888(defvar comp-last-scanned-async-output nil)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 21b3fbf98b3..57655403c20 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -781,6 +781,10 @@ This mainly sets up debugger-related bindings."
781 (ert--run-test-debugger test-execution-info 781 (ert--run-test-debugger test-execution-info
782 args))) 782 args)))
783 (debug-on-error t) 783 (debug-on-error t)
784 ;; Don't infloop if the error being called is erroring
785 ;; out, and we have `debug-on-error' bound to nil inside
786 ;; the test.
787 (backtrace-on-error-noninteractive nil)
784 (debug-on-quit t) 788 (debug-on-quit t)
785 ;; FIXME: Do we need to store the old binding of this 789 ;; FIXME: Do we need to store the old binding of this
786 ;; and consider it in `ert--run-test-debugger'? 790 ;; and consider it in `ert--run-test-debugger'?
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 51c822d21e2..25bd17bdb96 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1319,11 +1319,11 @@ function's documentation in the Info manual")))
1319 (princ value (current-buffer)) 1319 (princ value (current-buffer))
1320 (insert "\n")) 1320 (insert "\n"))
1321 (:eg-result 1321 (:eg-result
1322 (insert " eg. " double-arrow " ") 1322 (insert " e.g. " double-arrow " ")
1323 (prin1 value (current-buffer)) 1323 (prin1 value (current-buffer))
1324 (insert "\n")) 1324 (insert "\n"))
1325 (:eg-result-string 1325 (:eg-result-string
1326 (insert " eg. " double-arrow " ") 1326 (insert " e.g. " double-arrow " ")
1327 (princ value (current-buffer)) 1327 (princ value (current-buffer))
1328 (insert "\n"))))) 1328 (insert "\n")))))
1329 ;; Insert the arglist after doing the evals, in case that's pulled 1329 ;; Insert the arglist after doing the evals, in case that's pulled
diff --git a/lisp/faces.el b/lisp/faces.el
index 089cb889090..47f7f3f0f37 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."
2289 (let ((file (locate-library (concat term-file-prefix type)))) 2289 (let ((file (locate-library (concat term-file-prefix type))))
2290 (and file 2290 (and file
2291 (or (assoc file load-history) 2291 (or (assoc file load-history)
2292 (load (file-name-sans-extension file) 2292 (load (replace-regexp-in-string
2293 "\\.el\\(\\.gz\\)?\\'" ""
2294 file)
2293 t t))))) 2295 t t)))))
2294 type) 2296 type)
2295 ;; Next, try to find a matching initialization function, and call it. 2297 ;; Next, try to find a matching initialization function, and call it.
diff --git a/lisp/files.el b/lisp/files.el
index feec62799fa..5a6a33721b3 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5746,7 +5746,9 @@ This allows you to stop `save-some-buffers' from asking
5746about certain files that you'd usually rather not save. 5746about certain files that you'd usually rather not save.
5747 5747
5748This function is called (with no parameters) from the buffer to 5748This function is called (with no parameters) from the buffer to
5749be saved." 5749be saved. When the function's symbol has the property
5750`save-some-buffers-function', the higher-order function is supposed
5751to return a predicate used to check buffers."
5750 :group 'auto-save 5752 :group 'auto-save
5751 ;; FIXME nil should not be a valid option, let alone the default, 5753 ;; FIXME nil should not be a valid option, let alone the default,
5752 ;; eg so that add-function can be used. 5754 ;; eg so that add-function can be used.
@@ -5766,6 +5768,7 @@ of the directory that was default during command invocation."
5766 (project-root (project-current))) 5768 (project-root (project-current)))
5767 default-directory))) 5769 default-directory)))
5768 (lambda () (file-in-directory-p default-directory root)))) 5770 (lambda () (file-in-directory-p default-directory root))))
5771(put 'save-some-buffers-root 'save-some-buffers-function t)
5769 5772
5770(defun save-some-buffers (&optional arg pred) 5773(defun save-some-buffers (&optional arg pred)
5771 "Save some modified file-visiting buffers. Asks user about each one. 5774 "Save some modified file-visiting buffers. Asks user about each one.
@@ -5797,9 +5800,10 @@ change the additional actions you can take on files."
5797 (setq pred save-some-buffers-default-predicate)) 5800 (setq pred save-some-buffers-default-predicate))
5798 ;; Allow `pred' to be a function that returns a predicate 5801 ;; Allow `pred' to be a function that returns a predicate
5799 ;; with lexical bindings in its original environment (bug#46374). 5802 ;; with lexical bindings in its original environment (bug#46374).
5800 (let ((pred-fun (and (functionp pred) (funcall pred)))) 5803 (when (and (symbolp pred) (get pred 'save-some-buffers-function))
5801 (when (functionp pred-fun) 5804 (let ((pred-fun (and (functionp pred) (funcall pred))))
5802 (setq pred pred-fun))) 5805 (when (functionp pred-fun)
5806 (setq pred pred-fun))))
5803 (let* ((switched-buffer nil) 5807 (let* ((switched-buffer nil)
5804 (save-some-buffers--switch-window-callback 5808 (save-some-buffers--switch-window-callback
5805 (lambda (buffer) 5809 (lambda (buffer)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 6be5cd4a501..03bbc979a9c 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
176 completions)) 176 completions))
177 177
178(defun help--symbol-completion-table (string pred action) 178(defun help--symbol-completion-table (string pred action)
179 (if (and completions-detailed (eq action 'metadata)) 179 (if (eq action 'metadata)
180 '(metadata (affixation-function . help--symbol-completion-table-affixation)) 180 `(metadata
181 ,@(when completions-detailed
182 '((affixation-function . help--symbol-completion-table-affixation)))
183 (category . symbol-help))
181 (when help-enable-completion-autoload 184 (when help-enable-completion-autoload
182 (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) 185 (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
183 (help--load-prefixes prefixes))) 186 (help--load-prefixes prefixes)))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 1e1a6f852e8..13da7f99a38 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
943 completion-initials-try-completion completion-initials-all-completions 943 completion-initials-try-completion completion-initials-all-completions
944 "Completion of acronyms and initialisms. 944 "Completion of acronyms and initialisms.
945E.g. can complete M-x lch to list-command-history 945E.g. can complete M-x lch to list-command-history
946and C-x C-f ~/sew to ~/src/emacs/work.")) 946and C-x C-f ~/sew to ~/src/emacs/work.")
947 (shorthand
948 completion-shorthand-try-completion completion-shorthand-all-completions
949 "Completion of symbol shorthands setup in `read-symbol-shorthands'.
950E.g. can complete \"x-foo\" to \"xavier-foo\" if the shorthand
951((\"x-\" . \"xavier-\")) is set up in the buffer of origin."))
947 "List of available completion styles. 952 "List of available completion styles.
948Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS DOC): 953Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS DOC):
949where NAME is the name that should be used in `completion-styles', 954where NAME is the name that should be used in `completion-styles',
@@ -990,7 +995,8 @@ styles for specific categories, such as files, buffers, etc."
990 ;; e.g. one that does not anchor to bos. 995 ;; e.g. one that does not anchor to bos.
991 (project-file (styles . (substring))) 996 (project-file (styles . (substring)))
992 (xref-location (styles . (substring))) 997 (xref-location (styles . (substring)))
993 (info-menu (styles . (basic substring)))) 998 (info-menu (styles . (basic substring)))
999 (symbol-help (styles . (basic shorthand substring))))
994 "Default settings for specific completion categories. 1000 "Default settings for specific completion categories.
995Each entry has the shape (CATEGORY . ALIST) where ALIST is 1001Each entry has the shape (CATEGORY . ALIST) where ALIST is
996an association list that can specify properties such as: 1002an association list that can specify properties such as:
@@ -1618,6 +1624,9 @@ DONT-CYCLE tells the function not to setup cycling."
1618(defvar minibuffer--require-match nil 1624(defvar minibuffer--require-match nil
1619 "Value of REQUIRE-MATCH passed to `completing-read'.") 1625 "Value of REQUIRE-MATCH passed to `completing-read'.")
1620 1626
1627(defvar minibuffer--original-buffer nil
1628 "Buffer that was current when `completing-read' was called.")
1629
1621(defun minibuffer-complete-and-exit () 1630(defun minibuffer-complete-and-exit ()
1622 "Exit if the minibuffer contains a valid completion. 1631 "Exit if the minibuffer contains a valid completion.
1623Otherwise, try to complete the minibuffer contents. If 1632Otherwise, try to complete the minibuffer contents. If
@@ -4080,6 +4089,40 @@ which is at the core of flex logic. The extra
4080 (let ((newstr (completion-initials-expand string table pred))) 4089 (let ((newstr (completion-initials-expand string table pred)))
4081 (when newstr 4090 (when newstr
4082 (completion-pcm-try-completion newstr table pred (length newstr))))) 4091 (completion-pcm-try-completion newstr table pred (length newstr)))))
4092
4093;; Shorthand completion
4094;;
4095;; Iff there is a (("x-" . "string-library-")) shorthand setup and
4096;; string-library-foo is in candidates, complete x-foo to it.
4097
4098(defun completion-shorthand-try-completion (string table pred point)
4099 "Try completion with `read-symbol-shorthands' of original buffer."
4100 (cl-loop with expanded
4101 for (short . long) in
4102 (with-current-buffer minibuffer--original-buffer
4103 read-symbol-shorthands)
4104 for probe =
4105 (and (> point (length short))
4106 (string-prefix-p short string)
4107 (try-completion (setq expanded
4108 (concat long
4109 (substring
4110 string
4111 (length short))))
4112 table pred))
4113 when probe
4114 do (message "Shorthand expansion")
4115 and return (cons expanded (max (length long)
4116 (+ (- point (length short))
4117 (length long))))))
4118
4119(defun completion-shorthand-all-completions (_string _table _pred _point)
4120 ;; no-op: For now, we don't want shorthands to list all the possible
4121 ;; locally active longhands. For the completion categories where
4122 ;; this style is active, it could hide other more interesting
4123 ;; matches from subsequent styles.
4124 nil)
4125
4083 4126
4084(defvar completing-read-function #'completing-read-default 4127(defvar completing-read-function #'completing-read-default
4085 "The function called by `completing-read' to do its work. 4128 "The function called by `completing-read' to do its work.
@@ -4111,6 +4154,7 @@ See `completing-read' for the meaning of the arguments."
4111 ;; in minibuffer-local-filename-completion-map can 4154 ;; in minibuffer-local-filename-completion-map can
4112 ;; override bindings in base-keymap. 4155 ;; override bindings in base-keymap.
4113 base-keymap))) 4156 base-keymap)))
4157 (buffer (current-buffer))
4114 (result 4158 (result
4115 (minibuffer-with-setup-hook 4159 (minibuffer-with-setup-hook
4116 (lambda () 4160 (lambda ()
@@ -4119,7 +4163,8 @@ See `completing-read' for the meaning of the arguments."
4119 ;; FIXME: Remove/rename this var, see the next one. 4163 ;; FIXME: Remove/rename this var, see the next one.
4120 (setq-local minibuffer-completion-confirm 4164 (setq-local minibuffer-completion-confirm
4121 (unless (eq require-match t) require-match)) 4165 (unless (eq require-match t) require-match))
4122 (setq-local minibuffer--require-match require-match)) 4166 (setq-local minibuffer--require-match require-match)
4167 (setq-local minibuffer--original-buffer buffer))
4123 (read-from-minibuffer prompt initial-input keymap 4168 (read-from-minibuffer prompt initial-input keymap
4124 nil hist def inherit-input-method)))) 4169 nil hist def inherit-input-method))))
4125 (when (and (equal result "") def) 4170 (when (and (equal result "") def)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index d68d4c7b760..63ffb2d057b 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."
600 600
601 ;; The end. 601 ;; The end.
602 (when (and (null noninteractive) 602 (when (and (null noninteractive)
603 (or (eq visit t) (null visit) (stringp visit))) 603 (or (eq visit t) (string-or-null-p visit)))
604 (tramp-message v 0 "Wrote %s" filename)) 604 (tramp-message v 0 "Wrote %s" filename))
605 (run-hooks 'tramp-handle-write-region-hook)))) 605 (run-hooks 'tramp-handle-write-region-hook))))
606 606
@@ -933,8 +933,8 @@ implementation will be used."
933 (stderr (plist-get args :stderr))) 933 (stderr (plist-get args :stderr)))
934 (unless (stringp name) 934 (unless (stringp name)
935 (signal 'wrong-type-argument (list #'stringp name))) 935 (signal 'wrong-type-argument (list #'stringp name)))
936 (unless (or (null buffer) (bufferp buffer) (stringp buffer)) 936 (unless (or (bufferp buffer) (string-or-null-p buffer))
937 (signal 'wrong-type-argument (list #'stringp buffer))) 937 (signal 'wrong-type-argument (list #'bufferp buffer)))
938 (unless (consp command) 938 (unless (consp command)
939 (signal 'wrong-type-argument (list #'consp command))) 939 (signal 'wrong-type-argument (list #'consp command)))
940 (unless (or (null coding) 940 (unless (or (null coding)
@@ -951,7 +951,7 @@ implementation will be used."
951 (signal 'wrong-type-argument (list #'functionp filter))) 951 (signal 'wrong-type-argument (list #'functionp filter)))
952 (unless (or (null sentinel) (functionp sentinel)) 952 (unless (or (null sentinel) (functionp sentinel))
953 (signal 'wrong-type-argument (list #'functionp sentinel))) 953 (signal 'wrong-type-argument (list #'functionp sentinel)))
954 (unless (or (null stderr) (bufferp stderr) (stringp stderr)) 954 (unless (or (bufferp stderr) (string-or-null-p stderr))
955 (signal 'wrong-type-argument (list #'bufferp stderr))) 955 (signal 'wrong-type-argument (list #'bufferp stderr)))
956 (when (and (stringp stderr) (tramp-tramp-file-p stderr) 956 (when (and (stringp stderr) (tramp-tramp-file-p stderr)
957 (not (tramp-equal-remote default-directory stderr))) 957 (not (tramp-equal-remote default-directory stderr)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index dd92f226897..8fa53cb5a23 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2771,8 +2771,8 @@ implementation will be used."
2771 (stderr (plist-get args :stderr))) 2771 (stderr (plist-get args :stderr)))
2772 (unless (stringp name) 2772 (unless (stringp name)
2773 (signal 'wrong-type-argument (list #'stringp name))) 2773 (signal 'wrong-type-argument (list #'stringp name)))
2774 (unless (or (null buffer) (bufferp buffer) (stringp buffer)) 2774 (unless (or (bufferp buffer) (string-or-null-p buffer))
2775 (signal 'wrong-type-argument (list #'stringp buffer))) 2775 (signal 'wrong-type-argument (list #'bufferp buffer)))
2776 (unless (or (null command) (consp command)) 2776 (unless (or (null command) (consp command))
2777 (signal 'wrong-type-argument (list #'consp command))) 2777 (signal 'wrong-type-argument (list #'consp command)))
2778 (unless (or (null coding) 2778 (unless (or (null coding)
@@ -2789,7 +2789,7 @@ implementation will be used."
2789 (signal 'wrong-type-argument (list #'functionp filter))) 2789 (signal 'wrong-type-argument (list #'functionp filter)))
2790 (unless (or (null sentinel) (functionp sentinel)) 2790 (unless (or (null sentinel) (functionp sentinel))
2791 (signal 'wrong-type-argument (list #'functionp sentinel))) 2791 (signal 'wrong-type-argument (list #'functionp sentinel)))
2792 (unless (or (null stderr) (bufferp stderr) (stringp stderr)) 2792 (unless (or (bufferp stderr) (string-or-null-p stderr))
2793 (signal 'wrong-type-argument (list #'bufferp stderr))) 2793 (signal 'wrong-type-argument (list #'bufferp stderr)))
2794 (when (and (stringp stderr) 2794 (when (and (stringp stderr)
2795 (not (tramp-equal-remote default-directory stderr))) 2795 (not (tramp-equal-remote default-directory stderr)))
@@ -3513,7 +3513,7 @@ implementation will be used."
3513 (tramp-compat-funcall 'unlock-file lockname)) 3513 (tramp-compat-funcall 'unlock-file lockname))
3514 3514
3515 (when (and (null noninteractive) 3515 (when (and (null noninteractive)
3516 (or (eq visit t) (null visit) (stringp visit))) 3516 (or (eq visit t) (string-or-null-p visit)))
3517 (tramp-message v 0 "Wrote %s" filename)) 3517 (tramp-message v 0 "Wrote %s" filename))
3518 (run-hooks 'tramp-handle-write-region-hook))))) 3518 (run-hooks 'tramp-handle-write-region-hook)))))
3519 3519
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 87f3665d915..49f049d3f34 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."
1658 1658
1659 ;; The end. 1659 ;; The end.
1660 (when (and (null noninteractive) 1660 (when (and (null noninteractive)
1661 (or (eq visit t) (null visit) (stringp visit))) 1661 (or (eq visit t) (string-or-null-p visit)))
1662 (tramp-message v 0 "Wrote %s" filename)) 1662 (tramp-message v 0 "Wrote %s" filename))
1663 (run-hooks 'tramp-handle-write-region-hook)))) 1663 (run-hooks 'tramp-handle-write-region-hook))))
1664 1664
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 1bd4c5dc1c8..a1007863453 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -320,7 +320,7 @@ arguments to pass to the OPERATION."
320 320
321 ;; The end. 321 ;; The end.
322 (when (and (null noninteractive) 322 (when (and (null noninteractive)
323 (or (eq visit t) (null visit) (stringp visit))) 323 (or (eq visit t) (string-or-null-p visit)))
324 (tramp-message v 0 "Wrote %s" filename)) 324 (tramp-message v 0 "Wrote %s" filename))
325 (run-hooks 'tramp-handle-write-region-hook)))) 325 (run-hooks 'tramp-handle-write-region-hook))))
326 326
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index c0f1cb161ec..a8ae71b147c 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1304,7 +1304,7 @@ let-bind this variable."
1304;; "getconf PATH" yields: 1304;; "getconf PATH" yields:
1305;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin 1305;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
1306;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin 1306;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
1307;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin 1307;; GNU/Linux (Debian, Suse, RHEL, Cygwin, MINGW64): /bin:/usr/bin
1308;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! 1308;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
1309;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin 1309;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin
1310;; IRIX64: /usr/bin 1310;; IRIX64: /usr/bin
@@ -1326,9 +1326,9 @@ tilde expansion, all directory names starting with \"~\" will be ignored.
1326the command \"getconf PATH\". It is recommended to use this 1326the command \"getconf PATH\". It is recommended to use this
1327entry on head of this list, because these are the default 1327entry on head of this list, because these are the default
1328directories for POSIX compatible commands. On remote hosts which 1328directories for POSIX compatible commands. On remote hosts which
1329do not offer the getconf command (like cygwin), the value 1329do not offer the getconf command, the value \"/bin:/usr/bin\" is
1330\"/bin:/usr/bin\" is used instead. This entry is represented in 1330used instead. This entry is represented in the list by the
1331the list by the special value `tramp-default-remote-path'. 1331special value `tramp-default-remote-path'.
1332 1332
1333`Private Directories' are the settings of the $PATH environment, 1333`Private Directories' are the settings of the $PATH environment,
1334as given in your `~/.profile'. This entry is represented in 1334as 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
4127 (stderr (plist-get args :stderr))) 4127 (stderr (plist-get args :stderr)))
4128 (unless (stringp name) 4128 (unless (stringp name)
4129 (signal 'wrong-type-argument (list #'stringp name))) 4129 (signal 'wrong-type-argument (list #'stringp name)))
4130 (unless (or (null buffer) (bufferp buffer) (stringp buffer)) 4130 (unless (or (bufferp buffer) (string-or-null-p buffer))
4131 (signal 'wrong-type-argument (list #'stringp buffer))) 4131 (signal 'wrong-type-argument (list #'bufferp buffer)))
4132 (unless (consp command) 4132 (unless (consp command)
4133 (signal 'wrong-type-argument (list #'consp command))) 4133 (signal 'wrong-type-argument (list #'consp command)))
4134 (unless (or (null coding) 4134 (unless (or (null coding)
@@ -4564,7 +4564,7 @@ of."
4564 4564
4565 ;; The end. 4565 ;; The end.
4566 (when (and (null noninteractive) 4566 (when (and (null noninteractive)
4567 (or (eq visit t) (null visit) (stringp visit))) 4567 (or (eq visit t) (string-or-null-p visit)))
4568 (tramp-message v 0 "Wrote %s" filename)) 4568 (tramp-message v 0 "Wrote %s" filename))
4569 (run-hooks 'tramp-handle-write-region-hook)))) 4569 (run-hooks 'tramp-handle-write-region-hook))))
4570 4570
@@ -4630,9 +4630,8 @@ of."
4630 (let ((user (or (tramp-file-name-user vec) 4630 (let ((user (or (tramp-file-name-user vec)
4631 (with-tramp-connection-property vec "login-as" 4631 (with-tramp-connection-property vec "login-as"
4632 (save-window-excursion 4632 (save-window-excursion
4633 (let ((enable-recursive-minibuffers t)) 4633 (pop-to-buffer (tramp-get-connection-buffer vec))
4634 (pop-to-buffer (tramp-get-connection-buffer vec)) 4634 (read-string (match-string 0)))))))
4635 (read-string (match-string 0))))))))
4636 (with-current-buffer (tramp-get-connection-buffer vec) 4635 (with-current-buffer (tramp-get-connection-buffer vec)
4637 (tramp-message vec 6 "\n%s" (buffer-string))) 4636 (tramp-message vec 6 "\n%s" (buffer-string)))
4638 (tramp-message vec 3 "Sending login name `%s'" user) 4637 (tramp-message vec 3 "Sending login name `%s'" user)
@@ -4642,8 +4641,7 @@ of."
4642(defun tramp-action-password (proc vec) 4641(defun tramp-action-password (proc vec)
4643 "Query the user for a password." 4642 "Query the user for a password."
4644 (with-current-buffer (process-buffer proc) 4643 (with-current-buffer (process-buffer proc)
4645 (let ((enable-recursive-minibuffers t) 4644 (let ((case-fold-search t))
4646 (case-fold-search t))
4647 ;; Let's check whether a wrong password has been sent already. 4645 ;; Let's check whether a wrong password has been sent already.
4648 ;; Sometimes, the process returns a new password request 4646 ;; Sometimes, the process returns a new password request
4649 ;; immediately after rejecting the previous (wrong) one. 4647 ;; immediately after rejecting the previous (wrong) one.
@@ -4674,14 +4672,13 @@ of."
4674Send \"yes\" to remote process on confirmation, abort otherwise. 4672Send \"yes\" to remote process on confirmation, abort otherwise.
4675See also `tramp-action-yn'." 4673See also `tramp-action-yn'."
4676 (save-window-excursion 4674 (save-window-excursion
4677 (let ((enable-recursive-minibuffers t)) 4675 (pop-to-buffer (tramp-get-connection-buffer vec))
4678 (pop-to-buffer (tramp-get-connection-buffer vec)) 4676 (unless (yes-or-no-p (match-string 0))
4679 (unless (yes-or-no-p (match-string 0)) 4677 (kill-process proc)
4680 (kill-process proc) 4678 (throw 'tramp-action 'permission-denied))
4681 (throw 'tramp-action 'permission-denied)) 4679 (with-current-buffer (tramp-get-connection-buffer vec)
4682 (with-current-buffer (tramp-get-connection-buffer vec) 4680 (tramp-message vec 6 "\n%s" (buffer-string)))
4683 (tramp-message vec 6 "\n%s" (buffer-string))) 4681 (tramp-send-string vec (concat "yes" tramp-local-end-of-line)))
4684 (tramp-send-string vec (concat "yes" tramp-local-end-of-line))))
4685 t) 4682 t)
4686 4683
4687(defun tramp-action-yn (proc vec) 4684(defun tramp-action-yn (proc vec)
@@ -4689,14 +4686,13 @@ See also `tramp-action-yn'."
4689Send \"y\" to remote process on confirmation, abort otherwise. 4686Send \"y\" to remote process on confirmation, abort otherwise.
4690See also `tramp-action-yesno'." 4687See also `tramp-action-yesno'."
4691 (save-window-excursion 4688 (save-window-excursion
4692 (let ((enable-recursive-minibuffers t)) 4689 (pop-to-buffer (tramp-get-connection-buffer vec))
4693 (pop-to-buffer (tramp-get-connection-buffer vec)) 4690 (unless (y-or-n-p (match-string 0))
4694 (unless (y-or-n-p (match-string 0)) 4691 (kill-process proc)
4695 (kill-process proc) 4692 (throw 'tramp-action 'permission-denied))
4696 (throw 'tramp-action 'permission-denied)) 4693 (with-current-buffer (tramp-get-connection-buffer vec)
4697 (with-current-buffer (tramp-get-connection-buffer vec) 4694 (tramp-message vec 6 "\n%s" (buffer-string)))
4698 (tramp-message vec 6 "\n%s" (buffer-string))) 4695 (tramp-send-string vec (concat "y" tramp-local-end-of-line)))
4699 (tramp-send-string vec (concat "y" tramp-local-end-of-line))))
4700 t) 4696 t)
4701 4697
4702(defun tramp-action-terminal (_proc vec) 4698(defun tramp-action-terminal (_proc vec)
@@ -4830,7 +4826,8 @@ performed successfully. Any other value means an error."
4830 (save-restriction 4826 (save-restriction
4831 (with-tramp-progress-reporter 4827 (with-tramp-progress-reporter
4832 proc 3 "Waiting for prompts from remote shell" 4828 proc 3 "Waiting for prompts from remote shell"
4833 (let (exit) 4829 (let ((enable-recursive-minibuffers t)
4830 exit)
4834 (if timeout 4831 (if timeout
4835 (with-timeout (timeout (setq exit 'timeout)) 4832 (with-timeout (timeout (setq exit 'timeout))
4836 (while (not exit) 4833 (while (not exit)
diff --git a/lisp/org/oc-biblatex.el b/lisp/org/oc-biblatex.el
index f517e391398..daf56e792a6 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."
165 (org-cite-biblatex--atomic-arguments (list r) info)) 165 (org-cite-biblatex--atomic-arguments (list r) info))
166 (org-cite-get-references citation) 166 (org-cite-get-references citation)
167 "") 167 "")
168 ;; According to biblatex manual, left braces or brackets 168 ;; According to BibLaTeX manual, left braces or brackets
169 ;; following a multicite command could be parsed as other 169 ;; following a multicite command could be parsed as other
170 ;; arguments. So we look ahead and insert a \relax if 170 ;; arguments. So we stop any further parsing by inserting
171 ;; needed. 171 ;; a \relax unconditionally.
172 (and (let ((next (org-export-get-next-element citation info))) 172 "\\relax")))
173 (and next
174 (string-match (rx string-start (or "{" "["))
175 (org-export-data next info))))
176 "\\relax"))))
177 173
178(defun org-cite-biblatex--command (citation info base &optional multi no-opt) 174(defun org-cite-biblatex--command (citation info base &optional multi no-opt)
179 "Return biblatex command using BASE name for CITATION object. 175 "Return biblatex command using BASE name for CITATION object.
@@ -314,6 +310,7 @@ to the document, and set styles."
314 '((("author" "a") ("caps" "c") ("full" "f") ("caps-full" "cf")) 310 '((("author" "a") ("caps" "c") ("full" "f") ("caps-full" "cf"))
315 (("locators" "l") ("bare" "b") ("caps" "c") ("bare-caps" "bc")) 311 (("locators" "l") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
316 (("noauthor" "na")) 312 (("noauthor" "na"))
313 (("nocite" "n"))
317 (("text" "t") ("caps" "c")) 314 (("text" "t") ("caps" "c"))
318 (("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc")))) 315 (("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))))
319 316
diff --git a/lisp/org/oc.el b/lisp/org/oc.el
index bbf2195fbd8..2f741768f88 100644
--- a/lisp/org/oc.el
+++ b/lisp/org/oc.el
@@ -89,7 +89,6 @@
89(declare-function org-element-type "org-element" (element)) 89(declare-function org-element-type "org-element" (element))
90 90
91(declare-function org-export-derived-backend-p "org-export" (backend &rest backends)) 91(declare-function org-export-derived-backend-p "org-export" (backend &rest backends))
92(declare-function org-export-get-footnote-definition "org-export" (footnote-reference info))
93(declare-function org-export-get-next-element "org-export" (blob info &optional n)) 92(declare-function org-export-get-next-element "org-export" (blob info &optional n))
94(declare-function org-export-get-previous-element "org-export" (blob info &optional n)) 93(declare-function org-export-get-previous-element "org-export" (blob info &optional n))
95(declare-function org-export-raw-string "org-export" (s)) 94(declare-function org-export-raw-string "org-export" (s))
@@ -152,10 +151,10 @@ triplet following the pattern
152 (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) 151 (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE)
153 152
154There, NAME is the name of a registered citation processor providing export 153There, NAME is the name of a registered citation processor providing export
155functionality, as a symbol. BIBLIOGRAPHY-STYLE (resp. CITATION-STYLE) is the 154functionality, as a symbol. BIBLIOGRAPHY-STYLE (respectively CITATION-STYLE)
156desired default style to use when printing a bibliography (resp. exporting a 155is the desired default style to use when printing a bibliography (respectively
157citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and CITATION-STYLE are 156exporting a citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and
158optional. NAME is mandatory. 157CITATION-STYLE are optional. NAME is mandatory.
159 158
160The export process selects the citation processor associated to the current 159The export process selects the citation processor associated to the current
161export back-end, or the most specific back-end the current one is derived from, 160export back-end, or the most specific back-end the current one is derived from,
@@ -502,8 +501,8 @@ This function assumes S precedes CITATION."
502 501
503(defun org-cite--move-punct-before (punct citation s info) 502(defun org-cite--move-punct-before (punct citation s info)
504 "Move punctuation PUNCT before CITATION object. 503 "Move punctuation PUNCT before CITATION object.
505String S contains PUNCT. The function assumes S follows CITATION. 504String S contains PUNCT. INFO is the export state, as a property list.
506Parse tree is modified by side-effect." 505The function assumes S follows CITATION. Parse tree is modified by side-effect."
507 (if (equal s punct) 506 (if (equal s punct)
508 (org-element-extract-element s) ;it would be empty anyway 507 (org-element-extract-element s) ;it would be empty anyway
509 (org-element-set-element s (substring s (length punct)))) 508 (org-element-set-element s (substring s (length punct))))
@@ -799,9 +798,20 @@ INFO is the export communication channel, as a property list."
799 ;; Do not force entering inline definitions, since 798 ;; Do not force entering inline definitions, since
800 ;; `org-element-map' is going to enter it anyway. 799 ;; `org-element-map' is going to enter it anyway.
801 ((guard (eq 'inline (org-element-property :type datum)))) 800 ((guard (eq 'inline (org-element-property :type datum))))
801 ;; Find definition for current standard
802 ;; footnote reference. Unlike to
803 ;; `org-export-get-footnote-definition', do
804 ;; not cache results as they would contain
805 ;; un-processed citation objects.
802 (_ 806 (_
803 (funcall search-cites 807 (let ((label (org-element-property :label datum)))
804 (org-export-get-footnote-definition datum info))))) 808 (funcall
809 search-cites
810 (org-element-map data 'footnote-definition
811 (lambda (d)
812 (and
813 (equal label (org-element-property :label d))
814 (or (org-element-contents d) "")))))))))
805 info nil 'footnote-definition t)))) 815 info nil 'footnote-definition t))))
806 (funcall search-cites (plist-get info :parse-tree)) 816 (funcall search-cites (plist-get info :parse-tree))
807 (let ((result (nreverse cites))) 817 (let ((result (nreverse cites)))
@@ -877,13 +887,16 @@ modified by side-effect."
877 887
878INFO is the export state, as a property list. 888INFO is the export state, as a property list.
879 889
890Optional argument RULE is the punctuation rule used, as a triplet. When nil,
891rule is determined according to `org-cite-note-rules', which see.
892
880Optional argument PUNCT is a list of punctuation marks to be considered. 893Optional argument PUNCT is a list of punctuation marks to be considered.
881When nil, it defaults to `org-cite-punctuation-marks'. 894When nil, it defaults to `org-cite-punctuation-marks'.
882 895
883Parse tree is modified by side-effect. 896Parse tree is modified by side-effect.
884 897
885Note: when calling both `org-cite-adjust-note' and `org-cite-wrap-citation' on 898Note: when calling both `org-cite-adjust-note' and `org-cite-wrap-citation' on
886the same object, call `org-cite-adjust-punctuation' first." 899the same object, call `org-cite-adjust-note' first."
887 (when org-cite-adjust-note-numbers 900 (when org-cite-adjust-note-numbers
888 (pcase-let* ((rule (or rule (org-cite--get-note-rule info))) 901 (pcase-let* ((rule (or rule (org-cite--get-note-rule info)))
889 (punct-re (regexp-opt (or punct org-cite-punctuation-marks))) 902 (punct-re (regexp-opt (or punct org-cite-punctuation-marks)))
@@ -1274,11 +1287,13 @@ by side-effect."
1274 ;; Before removing the citation, transfer its `:post-blank' 1287 ;; Before removing the citation, transfer its `:post-blank'
1275 ;; property to the object before, if any. 1288 ;; property to the object before, if any.
1276 (org-cite--set-previous-post-blank cite blanks info) 1289 (org-cite--set-previous-post-blank cite blanks info)
1277 ;; We want to be sure any non-note citation is preceded by 1290 ;; Make sure there is a space between a quotation mark and
1278 ;; a space. This is particularly important when using 1291 ;; a citation. This is particularly important when using
1279 ;; `adaptive' note rule. See `org-cite-note-rules'. 1292 ;; `adaptive' note rule. See `org-cite-note-rules'.
1280 (unless (org-cite-inside-footnote-p cite t) 1293 (let ((previous (org-export-get-previous-element cite info)))
1281 (org-cite--set-previous-post-blank cite 1 info)) 1294 (when (and (org-string-nw-p previous)
1295 (string-suffix-p "\"" previous))
1296 (org-cite--set-previous-post-blank cite 1 info)))
1282 (pcase replacement 1297 (pcase replacement
1283 ;; String. 1298 ;; String.
1284 ((pred stringp) 1299 ((pred stringp)
@@ -1384,7 +1399,8 @@ ARG is the prefix argument received when calling `org-open-at-point', or nil."
1384 1399
1385;;; Meta-command for citation insertion (insert capability) 1400;;; Meta-command for citation insertion (insert capability)
1386(defun org-cite--allowed-p (context) 1401(defun org-cite--allowed-p (context)
1387 "Non-nil when a citation can be inserted at point." 1402 "Non-nil when a citation can be inserted at point.
1403CONTEXT is the element or object at point, as returned by `org-element-context'."
1388 (let ((type (org-element-type context))) 1404 (let ((type (org-element-type context)))
1389 (cond 1405 (cond
1390 ;; No citation in attributes, except in parsed ones. 1406 ;; 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."
1430 (skip-chars-backward " \r\t\n") 1446 (skip-chars-backward " \r\t\n")
1431 (if (eq (org-element-class context) 'object) (point) 1447 (if (eq (org-element-class context) 'object) (point)
1432 (line-beginning-position 2))))) 1448 (line-beginning-position 2)))))
1433 ;; At the start of a list item is fine, as long as the bullet is unaffected. 1449 ;; At the beginning of a footnote definition, right after the
1450 ;; label, is OK.
1451 ((eq type 'footnote-definition) (looking-at (rx space)))
1452 ;; At the start of a list item is fine, as long as the bullet is
1453 ;; unaffected.
1434 ((eq type 'item) 1454 ((eq type 'item)
1435 (> (point) (+ (org-element-property :begin context) 1455 (> (point) (+ (org-element-property :begin context)
1436 (current-indentation) 1456 (current-indentation)
diff --git a/lisp/org/ol-man.el b/lisp/org/ol-man.el
new file mode 100644
index 00000000000..0d9ac7c8c71
--- /dev/null
+++ b/lisp/org/ol-man.el
@@ -0,0 +1,86 @@
1;;; ol-man.el --- Links to man pages -*- lexical-binding: t; -*-
2;;
3;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
4;; Author: Carsten Dominik <carsten.dominik@gmail.com>
5;; Maintainer: Bastien Guerry <bzg@gnu.org>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: https://orgmode.org
8;;
9;; This file is part of GNU Emacs.
10;;
11;; This program is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; This program is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26
27(require 'ol)
28
29(org-link-set-parameters "man"
30 :follow #'org-man-open
31 :export #'org-man-export
32 :store #'org-man-store-link)
33
34(defcustom org-man-command 'man
35 "The Emacs command to be used to display a man page."
36 :group 'org-link
37 :type '(choice (const man) (const woman)))
38
39(defun org-man-open (path _)
40 "Visit the manpage on PATH.
41PATH should be a topic that can be thrown at the man command.
42If PATH contains extra ::STRING which will use `occur' to search
43matched strings in man buffer."
44 (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path)
45 (let* ((command (match-string 1 path))
46 (search (match-string 2 path)))
47 (funcall org-man-command command)
48 (when search
49 (with-current-buffer (concat "*Man " command "*")
50 (goto-char (point-min))
51 (search-forward search)))))
52
53(defun org-man-store-link ()
54 "Store a link to a README file."
55 (when (memq major-mode '(Man-mode woman-mode))
56 ;; This is a man page, we do make this link
57 (let* ((page (org-man-get-page-name))
58 (link (concat "man:" page))
59 (description (format "Manpage for %s" page)))
60 (org-link-store-props
61 :type "man"
62 :link link
63 :description description))))
64
65(defun org-man-get-page-name ()
66 "Extract the page name from the buffer name."
67 ;; This works for both `Man-mode' and `woman-mode'.
68 (if (string-match " \\(\\S-+\\)\\*" (buffer-name))
69 (match-string 1 (buffer-name))
70 (error "Cannot create link to this man page")))
71
72(defun org-man-export (link description format)
73 "Export a man page link from Org files."
74 (let ((path (format "http://man.he.net/?topic=%s&section=all" link))
75 (desc (or description link)))
76 (cond
77 ((eq format 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
78 ((eq format 'latex) (format "\\href{%s}{%s}" path desc))
79 ((eq format 'texinfo) (format "@uref{%s,%s}" path desc))
80 ((eq format 'ascii) (format "%s (%s)" desc path))
81 ((eq format 'md) (format "[%s](%s)" desc path))
82 (t path))))
83
84(provide 'ol-man)
85
86;;; ol-man.el ends here
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index c8c4dae8003..fcc7579bad5 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -281,7 +281,10 @@ otherwise."
281 (save-excursion (goto-char (org-element-property :end context)) 281 (save-excursion (goto-char (org-element-property :end context))
282 (skip-chars-backward " \r\t\n") 282 (skip-chars-backward " \r\t\n")
283 (if (eq (org-element-class context) 'object) (point) 283 (if (eq (org-element-class context) 'object) (point)
284 (1+ (line-beginning-position 2)))))) 284 (line-beginning-position 2)))))
285 ;; At the beginning of a footnote definition, right after the
286 ;; label, is OK.
287 ((eq type 'footnote-definition) (looking-at (rx space)))
285 ;; Other elements are invalid. 288 ;; Other elements are invalid.
286 ((eq (org-element-class context) 'element) nil) 289 ((eq (org-element-class context) 'element) nil)
287 ;; Just before object is fine. 290 ;; Just before object is fine.
diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el
index 5c64c5a5c94..da5e6ae7995 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."
350 (lambda (datum name) 350 (lambda (datum name)
351 (goto-char (org-element-property :begin datum)) 351 (goto-char (org-element-property :begin datum))
352 (re-search-forward 352 (re-search-forward
353 (format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name))) 353 (format "^[ \t]*#\\+[A-Za-z]+:[ \t]*%s[ \t]*$" (regexp-quote name)))
354 (match-beginning 0)) 354 (match-beginning 0))
355 (lambda (key) (format "Duplicate NAME \"%s\"" key)))) 355 (lambda (key) (format "Duplicate NAME \"%s\"" key))))
356 356
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 5bccbe497cc..9948008774d 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."
11(defun org-git-version () 11(defun org-git-version ()
12 "The Git version of Org mode. 12 "The Git version of Org mode.
13Inserted by installing Org or when a release is made." 13Inserted by installing Org or when a release is made."
14 (let ((org-git-version "release_9.5-30-g10dc9d")) 14 (let ((org-git-version "release_9.5-46-gb71474"))
15 org-git-version)) 15 org-git-version))
16 16
17(provide 'org-version) 17(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index bc0ea24bee7..c2a37e6cdd1 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',
15362 "Save all Org buffers without user confirmation." 15362 "Save all Org buffers without user confirmation."
15363 (interactive) 15363 (interactive)
15364 (message "Saving all Org buffers...") 15364 (message "Saving all Org buffers...")
15365 (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) 15365 (save-some-buffers t (lambda () (and (derived-mode-p 'org-mode) t)))
15366 (when (featurep 'org-id) (org-id-locations-save)) 15366 (when (featurep 'org-id) (org-id-locations-save))
15367 (message "Saving all Org buffers... done")) 15367 (message "Saving all Org buffers... done"))
15368 15368
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 3eaa789b3e9..da7435cddf3 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
1;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- 1;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
2 2
3;; Copyright (C) 2015-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
4;; Version: 0.8.0 4;; Version: 0.8.1
5;; Package-Requires: ((emacs "26.1") (xref "1.0.2")) 5;; Package-Requires: ((emacs "26.1") (xref "1.0.2"))
6 6
7;; This is a GNU ELPA :core package. Avoid using functionality that 7;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -316,16 +316,21 @@ to find the list of ignores for each directory."
316 " " 316 " "
317 (shell-quote-argument ")")) 317 (shell-quote-argument ")"))
318 ""))) 318 "")))
319 (output (with-output-to-string 319 res)
320 (with-current-buffer standard-output 320 (with-temp-buffer
321 (let ((status 321 (let ((status
322 (process-file-shell-command command nil t))) 322 (process-file-shell-command command nil t))
323 (unless (zerop status) 323 (pt (point-min)))
324 (error "File listing failed: %s" (buffer-string)))))))) 324 (unless (zerop status)
325 (error "File listing failed: %s" (buffer-string)))
326 (goto-char pt)
327 (while (search-forward "\0" nil t)
328 (push (buffer-substring-no-properties (1+ pt) (1- (point)))
329 res)
330 (setq pt (point)))))
325 (project--remote-file-names 331 (project--remote-file-names
326 (mapcar (lambda (s) (concat dfn (substring s 1))) 332 (mapcar (lambda (s) (concat dfn s))
327 (sort (split-string output "\0" t) 333 (sort res #'string<)))))
328 #'string<)))))
329 334
330(defun project--remote-file-names (local-files) 335(defun project--remote-file-names (local-files)
331 "Return LOCAL-FILES as if they were on the system of `default-directory'. 336 "Return LOCAL-FILES as if they were on the system of `default-directory'.
diff --git a/lisp/subr.el b/lisp/subr.el
index cca6d53ba73..fa097b3f19e 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."
3036 (set-keymap-parent map minibuffer-local-map) 3036 (set-keymap-parent map minibuffer-local-map)
3037 3037
3038 (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char) 3038 (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char)
3039 (define-key map [remap exit-minibuffer] #'read-char-from-minibuffer-insert-other)
3039 3040
3040 (define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom) 3041 (define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom)
3041 (define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command) 3042 (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;
3153 (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window) 3154 (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window)
3154 (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down) 3155 (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down)
3155 3156
3156 (define-key map [escape] #'abort-recursive-edit) 3157 (define-key map [remap exit] #'y-or-n-p-insert-other)
3157 (dolist (symbol '(quit exit exit-prefix)) 3158 (dolist (symbol '(exit-prefix quit))
3158 (define-key map (vector 'remap symbol) #'abort-recursive-edit)) 3159 (define-key map (vector 'remap symbol) #'abort-recursive-edit))
3160 (define-key map [escape] #'abort-recursive-edit)
3159 3161
3160 ;; FIXME: try catch-all instead of explicit bindings: 3162 ;; FIXME: try catch-all instead of explicit bindings:
3161 ;; (define-key map [remap t] #'y-or-n-p-insert-other) 3163 ;; (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) \",
3219where `help-char' is automatically bound to `help-form-show'. 3221where `help-char' is automatically bound to `help-form-show'.
3220 3222
3221No confirmation of the answer is requested; a single character is 3223No confirmation of the answer is requested; a single character is
3222enough. RET and SPC also means yes, and DEL means no. 3224enough. SPC also means yes, and DEL means no.
3223 3225
3224To be precise, this function translates user input into responses 3226To be precise, this function translates user input into responses
3225by consulting the bindings in `query-replace-map'; see the 3227by consulting the bindings in `query-replace-map'; see the
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 87a8b7b4519..348ccc6f8ec 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -194,7 +194,9 @@ really edit the buffer? (%s, %s, %s or %s) "
194 (list "File reverted" filename))) 194 (list "File reverted" filename)))
195 ((eq answer ?n) 195 ((eq answer ?n)
196 (signal 'file-supersession 196 (signal 'file-supersession
197 (list "File changed on disk" filename))))) 197 (list "File changed on disk" filename)))
198 ((eq answer ?y))
199 (t (setq answer nil))))
198 (message 200 (message
199 "File on disk now will become a backup file if you save these changes.") 201 "File on disk now will become a backup file if you save these changes.")
200 (setq buffer-backed-up nil)))) 202 (setq buffer-backed-up nil))))
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index a795fe76518..e314edcfb53 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -139,6 +139,7 @@ AC_DEFUN([gl_EARLY],
139 # Code from module mktime-internal: 139 # Code from module mktime-internal:
140 # Code from module multiarch: 140 # Code from module multiarch:
141 # Code from module nocrash: 141 # Code from module nocrash:
142 # Code from module nproc:
142 # Code from module nstrftime: 143 # Code from module nstrftime:
143 # Code from module open: 144 # Code from module open:
144 # Code from module openat-h: 145 # Code from module openat-h:
@@ -413,6 +414,7 @@ AC_DEFUN([gl_INIT],
413 fi 414 fi
414 gl_TIME_MODULE_INDICATOR([mktime]) 415 gl_TIME_MODULE_INDICATOR([mktime])
415 gl_MULTIARCH 416 gl_MULTIARCH
417 gl_NPROC
416 gl_FUNC_GNU_STRFTIME 418 gl_FUNC_GNU_STRFTIME
417 gl_PATHMAX 419 gl_PATHMAX
418 gl_FUNC_PIPE2 420 gl_FUNC_PIPE2
@@ -1221,6 +1223,8 @@ AC_DEFUN([gl_FILE_LIST], [
1221 lib/mkostemp.c 1223 lib/mkostemp.c
1222 lib/mktime-internal.h 1224 lib/mktime-internal.h
1223 lib/mktime.c 1225 lib/mktime.c
1226 lib/nproc.c
1227 lib/nproc.h
1224 lib/nstrftime.c 1228 lib/nstrftime.c
1225 lib/open.c 1229 lib/open.c
1226 lib/openat-priv.h 1230 lib/openat-priv.h
@@ -1370,6 +1374,7 @@ AC_DEFUN([gl_FILE_LIST], [
1370 m4/mode_t.m4 1374 m4/mode_t.m4
1371 m4/multiarch.m4 1375 m4/multiarch.m4
1372 m4/nocrash.m4 1376 m4/nocrash.m4
1377 m4/nproc.m4
1373 m4/nstrftime.m4 1378 m4/nstrftime.m4
1374 m4/off_t.m4 1379 m4/off_t.m4
1375 m4/open-cloexec.m4 1380 m4/open-cloexec.m4
diff --git a/m4/nproc.m4 b/m4/nproc.m4
new file mode 100644
index 00000000000..887c66bee81
--- /dev/null
+++ b/m4/nproc.m4
@@ -0,0 +1,54 @@
1# nproc.m4 serial 5
2dnl Copyright (C) 2009-2021 Free Software Foundation, Inc.
3dnl This file is free software; the Free Software Foundation
4dnl gives unlimited permission to copy and/or distribute it,
5dnl with or without modifications, as long as this notice is preserved.
6
7AC_DEFUN([gl_NPROC],
8[
9 gl_PREREQ_NPROC
10])
11
12# Prerequisites of lib/nproc.c.
13AC_DEFUN([gl_PREREQ_NPROC],
14[
15 dnl Persuade glibc <sched.h> to declare CPU_SETSIZE, CPU_ISSET etc.
16 AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
17
18 AC_CHECK_HEADERS([sys/pstat.h sys/sysmp.h sys/param.h],,,
19 [AC_INCLUDES_DEFAULT])
20 dnl <sys/sysctl.h> requires <sys/param.h> on OpenBSD 4.0.
21 AC_CHECK_HEADERS([sys/sysctl.h],,,
22 [AC_INCLUDES_DEFAULT
23 #if HAVE_SYS_PARAM_H
24 # include <sys/param.h>
25 #endif
26 ])
27
28 AC_CHECK_FUNCS([sched_getaffinity sched_getaffinity_np \
29 pstat_getdynamic sysmp sysctl])
30
31 dnl Test whether sched_getaffinity has the expected declaration.
32 dnl glibc 2.3.[0-2]:
33 dnl int sched_getaffinity (pid_t, unsigned int, unsigned long int *);
34 dnl glibc 2.3.3:
35 dnl int sched_getaffinity (pid_t, cpu_set_t *);
36 dnl glibc >= 2.3.4:
37 dnl int sched_getaffinity (pid_t, size_t, cpu_set_t *);
38 if test $ac_cv_func_sched_getaffinity = yes; then
39 AC_CACHE_CHECK([for glibc compatible sched_getaffinity],
40 [gl_cv_func_sched_getaffinity3],
41 [AC_COMPILE_IFELSE(
42 [AC_LANG_PROGRAM(
43 [[#include <errno.h>
44 #include <sched.h>]],
45 [[sched_getaffinity (0, 0, (cpu_set_t *) 0);]])],
46 [gl_cv_func_sched_getaffinity3=yes],
47 [gl_cv_func_sched_getaffinity3=no])
48 ])
49 if test $gl_cv_func_sched_getaffinity3 = yes; then
50 AC_DEFINE([HAVE_SCHED_GETAFFINITY_LIKE_GLIBC], [1],
51 [Define to 1 if sched_getaffinity has a glibc compatible declaration.])
52 fi
53 fi
54])
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk
index f1f4c4c2790..e9f00e748ea 100644
--- a/nt/gnulib-cfg.mk
+++ b/nt/gnulib-cfg.mk
@@ -73,3 +73,4 @@ OMIT_GNULIB_MODULE_lchmod = true
73OMIT_GNULIB_MODULE_futimens = true 73OMIT_GNULIB_MODULE_futimens = true
74OMIT_GNULIB_MODULE_utimensat = true 74OMIT_GNULIB_MODULE_utimensat = true
75OMIT_GNULIB_MODULE_file-has-acl = true 75OMIT_GNULIB_MODULE_file-has-acl = true
76OMIT_GNULIB_MODULE_nproc = true
diff --git a/src/process.c b/src/process.c
index 221d4c7f6c3..746cdc0428a 100644
--- a/src/process.c
+++ b/src/process.c
@@ -90,6 +90,7 @@ static struct rlimit nofile_limit;
90 90
91#include <c-ctype.h> 91#include <c-ctype.h>
92#include <flexmember.h> 92#include <flexmember.h>
93#include <nproc.h>
93#include <sig2str.h> 94#include <sig2str.h>
94#include <verify.h> 95#include <verify.h>
95 96
@@ -8212,6 +8213,20 @@ integer or floating point values.
8212 return system_process_attributes (pid); 8213 return system_process_attributes (pid);
8213} 8214}
8214 8215
8216DEFUN ("num-processors", Fnum_processors, Snum_processors, 0, 1, 0,
8217 doc: /* Return the number of processors, a positive integer.
8218Each usable thread execution unit counts as a processor.
8219By default, count the number of available processors,
8220overridable via the OMP_NUM_THREADS environment variable.
8221If optional argument QUERY is `current', ignore OMP_NUM_THREADS.
8222If QUERY is `all', also count processors not available. */)
8223 (Lisp_Object query)
8224{
8225 return make_uint (num_processors (EQ (query, Qall) ? NPROC_ALL
8226 : EQ (query, Qcurrent) ? NPROC_CURRENT
8227 : NPROC_CURRENT_OVERRIDABLE));
8228}
8229
8215#ifdef subprocesses 8230#ifdef subprocesses
8216/* Arrange to catch SIGCHLD if this hasn't already been arranged. 8231/* Arrange to catch SIGCHLD if this hasn't already been arranged.
8217 Invoke this after init_process_emacs, and after glib and/or GNUstep 8232 Invoke this after init_process_emacs, and after glib and/or GNUstep
@@ -8472,6 +8487,8 @@ syms_of_process (void)
8472 DEFSYM (Qpcpu, "pcpu"); 8487 DEFSYM (Qpcpu, "pcpu");
8473 DEFSYM (Qpmem, "pmem"); 8488 DEFSYM (Qpmem, "pmem");
8474 DEFSYM (Qargs, "args"); 8489 DEFSYM (Qargs, "args");
8490 DEFSYM (Qall, "all");
8491 DEFSYM (Qcurrent, "current");
8475 8492
8476 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes, 8493 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
8477 doc: /* Non-nil means delete processes immediately when they exit. 8494 doc: /* Non-nil means delete processes immediately when they exit.
@@ -8633,4 +8650,5 @@ amounts of data in one go. */);
8633 defsubr (&Sprocess_inherit_coding_system_flag); 8650 defsubr (&Sprocess_inherit_coding_system_flag);
8634 defsubr (&Slist_system_processes); 8651 defsubr (&Slist_system_processes);
8635 defsubr (&Sprocess_attributes); 8652 defsubr (&Sprocess_attributes);
8653 defsubr (&Snum_processors);
8636} 8654}
diff --git a/src/w32.c b/src/w32.c
index 0eb69d4b1d1..9fe698d28d7 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/>. */
39#include <sys/time.h> 39#include <sys/time.h>
40#include <sys/utime.h> 40#include <sys/utime.h>
41#include <math.h> 41#include <math.h>
42#include <nproc.h>
42 43
43/* Include (most) CRT headers *before* ms-w32.h. */ 44/* Include (most) CRT headers *before* ms-w32.h. */
44#include <ms-w32.h> 45#include <ms-w32.h>
@@ -1962,6 +1963,16 @@ w32_get_nproc (void)
1962 return num_of_processors; 1963 return num_of_processors;
1963} 1964}
1964 1965
1966/* Emulate Gnulib's 'num_processors'. We cannot use the Gnulib
1967 version because it unconditionally calls APIs that aren't available
1968 on old MS-Windows versions. */
1969unsigned long
1970num_processors (enum nproc_query query)
1971{
1972 /* We ignore QUERY. */
1973 return w32_get_nproc ();
1974}
1975
1965static void 1976static void
1966sample_system_load (ULONGLONG *idle, ULONGLONG *kernel, ULONGLONG *user) 1977sample_system_load (ULONGLONG *idle, ULONGLONG *kernel, ULONGLONG *user)
1967{ 1978{
diff --git a/src/w32proc.c b/src/w32proc.c
index 702ea122e65..360f45e9e11 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -3878,14 +3878,6 @@ w32_compare_strings (const char *s1, const char *s2, char *locname,
3878 return val - 2; 3878 return val - 2;
3879} 3879}
3880 3880
3881DEFUN ("w32-get-nproc", Fw32_get_nproc,
3882 Sw32_get_nproc, 0, 0, 0,
3883 doc: /* Return the number of system's processor execution units. */)
3884 (void)
3885{
3886 return make_fixnum (w32_get_nproc ());
3887}
3888
3889 3881
3890void 3882void
3891syms_of_ntproc (void) 3883syms_of_ntproc (void)
@@ -3920,8 +3912,6 @@ syms_of_ntproc (void)
3920 defsubr (&Sw32_get_keyboard_layout); 3912 defsubr (&Sw32_get_keyboard_layout);
3921 defsubr (&Sw32_set_keyboard_layout); 3913 defsubr (&Sw32_set_keyboard_layout);
3922 3914
3923 defsubr (&Sw32_get_nproc);
3924
3925 DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args, 3915 DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args,
3926 doc: /* Non-nil enables quoting of process arguments to ensure correct parsing. 3916 doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
3927Because Windows does not directly pass argv arrays to child processes, 3917Because Windows does not directly pass argv arrays to child processes,
diff --git a/src/xdisp.c b/src/xdisp.c
index 9ddf0dd54b5..d8aff5084c4 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
10073 10073
10074 case MOVE_NEWLINE_OR_CR: 10074 case MOVE_NEWLINE_OR_CR:
10075 max_current_x = max (it->current_x, max_current_x); 10075 max_current_x = max (it->current_x, max_current_x);
10076 if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
10077 it->override_ascent = -1;
10076 set_iterator_to_next (it, true); 10078 set_iterator_to_next (it, true);
10077 it->continuation_lines_width = 0; 10079 it->continuation_lines_width = 0;
10078 break; 10080 break;
diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el
index bf684dbbea8..a10c29fcf71 100644
--- a/test/lisp/mh-e/mh-utils-tests.el
+++ b/test/lisp/mh-e/mh-utils-tests.el
@@ -17,6 +17,34 @@
17;; You should have received a copy of the GNU General Public License 17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
19 19
20;;; Commentary:
21
22;; This test suite runs tests that use and depend on MH programs
23;; installed on the system.
24
25;; When running such tests, MH-E can use a particular MH variant
26;; installed on the system, or it can use the mocks provided here.
27;; (Setup is done by the `with-mh-test-env' macro.)
28
29;; By setting environment variable TEST_MH_PATH, you can select which of
30;; the installed MH variants to use, or ignore them all and use mocks.
31;; See also the script test-all-mh-variants.sh in this directory.
32
33;; 1. To run these tests against the default MH variant installed on
34;; this system:
35;; cd ../.. && make lisp/mh-e/mh-utils-tests
36
37;; 2. To run these tests against an MH variant installed in a
38;; specific directory, set TEST_MH_PATH, as in this example:
39;; cd ../.. && make lisp/mh-e/mh-utils-tests TEST_MH_PATH=/usr/local/nmh/bin
40
41;; 3. To search for and run these tests against all MH variants
42;; installed on this system:
43;; ./test-all-mh-variants.sh
44
45;; Setting the environment variable TEST_MH_DEBUG or the Lisp variable
46;; mh-test-utils-debug-mocks logs access to the file system during the test.
47
20;;; Code: 48;;; Code:
21 49
22(require 'ert) 50(require 'ert)
@@ -56,34 +84,32 @@
56;; Folder names that are used by the following tests. 84;; Folder names that are used by the following tests.
57(defvar mh-test-rel-folder "rela-folder") 85(defvar mh-test-rel-folder "rela-folder")
58(defvar mh-test-abs-folder "/abso-folder") 86(defvar mh-test-abs-folder "/abso-folder")
59(defvar mh-test-no-such-folder "/testdir/none" 87(defvar mh-test-no-such-folder "/testdir/none" "A folder that does not exist.")
60 "Name of a folder that the user does not have.") 88
89(defvar mh-test-utils-variants nil
90 "The value of `mh-variants' used for these tests.
91This variable allows setting `mh-variants' to a limited set for targeted
92testing. Its value can be different from the normal value when
93environment variable TEST_MH_PATH is set. By remembering the value, we
94can log the choice only once, which makes the batch log easier to read.")
61 95
62(defvar mh-test-variant-logged-already nil 96(defvar mh-test-variant-logged-already nil
63 "Whether `with-mh-test-env' has written the MH variant to the log.") 97 "Whether `with-mh-test-env' has written the MH variant to the log.")
64(setq mh-test-variant-logged-already nil) ;reset if buffer is re-evaluated
65 98
66(defvar mh-test-utils-debug-mocks nil 99(defvar mh-test-utils-debug-mocks (> (length (getenv "TEST_MH_DEBUG")) 0)
67 "Whether to log detailed behavior of mock functions.") 100 "Whether to log detailed behavior of mock functions.")
68 101
69(defvar mh-test-call-process-real (symbol-function 'call-process)) 102(defvar mh-test-call-process-real (symbol-function 'call-process))
70(defvar mh-test-file-directory-p-real (symbol-function 'file-directory-p)) 103(defvar mh-test-file-directory-p-real (symbol-function 'file-directory-p))
71 104
72 105;;; The macro with-mh-test-env wraps tests that touch the file system
73;;; This macro wraps tests that touch the file system and/or run programs. 106;;; and/or run programs.
74;;; When running such tests, MH-E can use a particular MH variant
75;;; installed on the system, or it can use the mocks provided below.
76
77;;; By setting PATH and mh-sys-path, you can select which of the
78;;; installed MH variants to use or ignore them all and use mocks.
79 107
80(defmacro with-mh-test-env (&rest body) 108(defmacro with-mh-test-env (&rest body)
81 "Evaluate BODY with a test mail environment. 109 "Evaluate BODY with a test mail environment.
82Functions that touch the file system or run MH programs are either 110Functions that touch the file system or run MH programs are either
83mocked out or pointed at a test tree. When called from Emacs's batch 111mocked out or pointed at a test tree. Uses `mh-test-utils-setup' to
84testing infrastructure, this will use mocks and thus run on systems 112select which."
85that do not have any MH variant installed. MH-E developers can
86install an MH variant and test it interactively."
87 (declare (indent defun)) 113 (declare (indent defun))
88 `(cl-letf ((temp-home-dir nil) 114 `(cl-letf ((temp-home-dir nil)
89 ;; make local bindings for things we will modify for test env 115 ;; make local bindings for things we will modify for test env
@@ -93,26 +119,56 @@ install an MH variant and test it interactively."
93 ((symbol-function 'file-directory-p)) 119 ((symbol-function 'file-directory-p))
94 ;; the test always gets its own sub-folders cache 120 ;; the test always gets its own sub-folders cache
95 (mh-sub-folders-cache (make-hash-table :test #'equal)) 121 (mh-sub-folders-cache (make-hash-table :test #'equal))
122 ;; Allow envvar TEST_MH_PATH to control mh-variants.
123 (mh-variants mh-test-utils-variants)
96 ;; remember the original value 124 ;; remember the original value
125 (original-mh-test-variant-logged mh-test-variant-logged-already)
126 (original-mh-path mh-path)
127 (original-mh-sys-path mh-sys-path)
128 (original-exec-path exec-path)
129 (original-mh-variant-in-use mh-variant-in-use)
130 (original-mh-progs mh-progs)
131 (original-mh-lib mh-lib)
132 (original-mh-lib-progs mh-lib-progs)
97 (original-mh-envvar (getenv "MH"))) 133 (original-mh-envvar (getenv "MH")))
98 (unwind-protect 134 (unwind-protect
99 (progn 135 (progn
100 (setq temp-home-dir (mh-test-utils-setup)) 136 (setq temp-home-dir (mh-test-utils-setup))
101 ,@body) 137 ,@body)
138 (unless noninteractive
139 ;; If interactive, forget that we logged the variant and
140 ;; restore any changes TEST_MH_PATH made.
141 (setq mh-test-variant-logged-already original-mh-test-variant-logged
142 mh-path original-mh-path
143 mh-sys-path original-mh-sys-path
144 exec-path original-exec-path
145 mh-variant-in-use original-mh-variant-in-use
146 mh-progs original-mh-progs
147 mh-lib original-mh-lib
148 mh-lib-progs original-mh-lib-progs))
102 (if temp-home-dir (delete-directory temp-home-dir t)) 149 (if temp-home-dir (delete-directory temp-home-dir t))
103 (setenv "MH" original-mh-envvar)))) 150 (setenv "MH" original-mh-envvar))))
104 151
105(defun mh-test-utils-setup () 152(defun mh-test-utils-setup ()
106 "Set dynamically bound variables needed by mock and/or variants. 153 "Set dynamically bound variables needed by mock and/or variants.
154Call `mh-variant-set' to look through the directories named by
155envionment variable `TEST_MH_PATH' (default: `mh-path' and `mh-sys-path')
156to find the MH variant to use, if any.
107Return the name of the root of the created directory tree, if any." 157Return the name of the root of the created directory tree, if any."
158 (when (getenv "TEST_MH_PATH")
159 ;; force mh-variants to use only TEST_MH_PATH
160 (setq mh-path (split-string (getenv "TEST_MH_PATH") path-separator t)
161 mh-sys-path nil
162 exec-path '("/bin" "/usr/bin")))
108 (unless mh-test-variant-logged-already 163 (unless mh-test-variant-logged-already
109 (mh-variant-set mh-variant) 164 (mh-variant-set mh-variant)
165 (setq mh-test-utils-variants mh-variants)
110 (setq mh-test-variant-logged-already t)) 166 (setq mh-test-variant-logged-already t))
111 ;; As `call-process'' and `file-directory-p' will be redefined, the
112 ;; native compiler will invoke `call-process' to compile the
113 ;; respective trampolines. To avoid interference with the
114 ;; `call-process' mocking, we build these ahead of time.
115 (when (native-comp-available-p) 167 (when (native-comp-available-p)
168 ;; As `call-process'' and `file-directory-p' will be redefined, the
169 ;; native compiler will invoke `call-process' to compile the
170 ;; respective trampolines. To avoid interference with the
171 ;; `call-process' mocking, we build these ahead of time.
116 (mapc #'comp-subr-trampoline-install '(call-process file-directory-p))) 172 (mapc #'comp-subr-trampoline-install '(call-process file-directory-p)))
117 (if mh-variant-in-use 173 (if mh-variant-in-use
118 (mh-test-utils-setup-with-variant) 174 (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 00000000000..e917d8155bc
--- /dev/null
+++ b/test/lisp/mh-e/test-all-mh-variants.sh
@@ -0,0 +1,104 @@
1#! /bin/bash
2# Run the mh-utils-tests against all MH variants found on this system.
3
4# Copyright (C) 2021 Free Software Foundation, Inc.
5
6# This file is part of GNU Emacs.
7
8# GNU Emacs is free software: you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation, either version 3 of the License, or
11# (at your option) any later version.
12
13# GNU Emacs is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16# GNU General Public License for more details.
17
18# You should have received a copy of the GNU General Public License
19# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
20
21# Commentary:
22
23# By default runs all tests; test names or Emacs-style regexps may be
24# given on the command line to run just those tests.
25#
26# Option -d turns on Emacs variable mh-test-utils-debug-mocks, which
27# causes the tests to output all interactions with the file system.
28
29# If you want to run the tests for only one MH variant, you don't need
30# to use this script, because "make" can do it. See the commentary at
31# the top of ./mh-utils-tests.el for the recipe.
32
33debug=
34if [[ "$1" = -* ]]; then
35 if [[ "$1" != -d ]]; then
36 echo "Usage: $(basename "$0") [-d] [test ...]" >&2
37 exit 2
38 fi
39 debug=t
40 shift
41fi
42
43shopt -s extglob
44ert_test_list=()
45for tst; do
46 # Guess the type the test spec
47 case $tst in
48 *[\[\].*+\\]*) # Regexp: put in string quotes
49 ert_test_list+=("\"$tst\"")
50 ;;
51 *) # Lisp expression, keyword, or symbol: use as is
52 ert_test_list+=("$tst")
53 ;;
54 esac
55done
56if [[ ${#ert_test_list[@]} -eq 0 ]]; then
57 # t means true for all tests, runs everything
58 ert_test_list=(t)
59fi
60
61# This script is 3 directories down in the Emacs source tree.
62cd "$(dirname "$0")"
63cd ../../..
64emacs=(src/emacs --batch -Q)
65
66# MH-E has a good list of directories where an MH variant might be installed,
67# so we look in each of those.
68read -r -a mh_sys_path \
69 < <("${emacs[@]}" -l mh-e --eval "(princ mh-sys-path)" | sed 's/[()]//g')
70
71have_done_mocked_variant=false
72declare -i tests_total=0 tests_passed=0
73
74for path in "${mh_sys_path[@]}"; do
75 if [[ ! -x "$path/mhparam" ]]; then
76 if [[ "$have_done_mocked_variant" = false ]]; then
77 have_done_mocked_variant=true
78 else
79 continue
80 fi
81 fi
82 echo "Testing with PATH $path"
83 ((++tests_total))
84 # The LD_LIBRARY_PATH setting is needed
85 # to run locally installed Mailutils.
86 TEST_MH_PATH=$path TEST_MH_DEBUG=$debug \
87 LD_LIBRARY_PATH=/usr/local/lib HOME=/nonexistent \
88 "${emacs[@]}" -l ert \
89 --eval "(setq load-prefer-newer t)" \
90 --eval "(load \"$PWD/test/lisp/mh-e/mh-utils-tests\" nil t)" \
91 --eval "(ert-run-tests-batch-and-exit '(or ${ert_test_list[*]}))" \
92 && ((++tests_passed))
93done
94
95if (( tests_total == 0 )); then
96 echo "NO tests run"
97 exit 1
98elif (( tests_total == tests_passed )); then
99 echo "All tested variants pass: $tests_passed/$tests_total"
100else
101 echo "Tested variants passing: $tests_passed/$tests_total," \
102 "FAILING: $((tests_total - tests_passed))/$tests_total"
103 exit 1
104fi
diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el
index 3856dcd717a..4d339934f83 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -1082,6 +1082,18 @@ evaluation of BODY."
1082 (should (= 84 (funcall (intern-soft "f-test4---")))) 1082 (should (= 84 (funcall (intern-soft "f-test4---"))))
1083 (should (unintern "f-test4---")))) 1083 (should (unintern "f-test4---"))))
1084 1084
1085(ert-deftest elisp-dont-shadow-punctuation-only-symbols ()
1086 :expected-result :failed ; bug#51089
1087 (let* ((shorthanded-form '(- 42 (-foo 42)))
1088 (expected-longhand-form '(- 42 (fooey-foo 42)))
1089 (observed (let ((read-symbol-shorthands
1090 '(("-" . "fooey-"))))
1091 (car (read-from-string
1092 (with-temp-buffer
1093 (print shorthanded-form (current-buffer))
1094 (buffer-string)))))))
1095 (should (equal observed expected-longhand-form))))
1096
1085(ert-deftest test-indentation () 1097(ert-deftest test-indentation ()
1086 (ert-test-erts-file (ert-resource-file "elisp-indents.erts")) 1098 (ert-test-erts-file (ert-resource-file "elisp-indents.erts"))
1087 (ert-test-erts-file (ert-resource-file "flet.erts") 1099 (ert-test-erts-file (ert-resource-file "flet.erts")
@@ -1089,5 +1101,17 @@ evaluation of BODY."
1089 (emacs-lisp-mode) 1101 (emacs-lisp-mode)
1090 (indent-region (point-min) (point-max))))) 1102 (indent-region (point-min) (point-max)))))
1091 1103
1104(ert-deftest test-cl-flet-indentation ()
1105 :expected-result :failed ; FIXME: bug#9622
1106 (should (equal
1107 (with-temp-buffer
1108 (emacs-lisp-mode)
1109 (insert "(cl-flet ((bla (x)\n(* x x)))\n(bla 42))")
1110 (indent-region (point-min) (point-max))
1111 (buffer-string))
1112 "(cl-flet ((bla (x)
1113 (* x x)))
1114 (bla 42))")))
1115
1092(provide 'elisp-mode-tests) 1116(provide 'elisp-mode-tests)
1093;;; elisp-mode-tests.el ends here 1117;;; elisp-mode-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index e39f57d23be..44f3ea2fbb4 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -946,5 +946,11 @@ Return nil if FILENAME doesn't exist."
946 (when buf 946 (when buf
947 (kill-buffer buf))))) 947 (kill-buffer buf)))))
948 948
949(ert-deftest process-num-processors ()
950 "Sanity checks for num-processors."
951 (should (equal (num-processors) (num-processors)))
952 (should (integerp (num-processors)))
953 (should (< 0 (num-processors))))
954
949(provide 'process-tests) 955(provide 'process-tests)
950;;; process-tests.el ends here 956;;; process-tests.el ends here