diff options
| author | Glenn Morris | 2021-10-11 08:04:57 -0700 |
|---|---|---|
| committer | Glenn Morris | 2021-10-11 08:04:57 -0700 |
| commit | 8aceb37b47a8f97fc42caaaf021ac06dc9f67827 (patch) | |
| tree | 64e2d073d3980d633a68349b8872b534a5427d59 | |
| parent | 395273773cb7035358cdd7c87f9102af75e39915 (diff) | |
| parent | 1a1b206a8b33dc597fe2153a59fa30baacf1dcc8 (diff) | |
| download | emacs-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
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 | ||
| 17459 | Here is a simple extension to Emacs that moves the line point is on to | 17459 | Here is a simple extension to Emacs that moves the line that point is |
| 17460 | the top of the window. I use this all the time, to make text easier | 17460 | on to the top of the window. I use this all the time, to make text |
| 17461 | to read. | 17461 | easier to read. |
| 17462 | 17462 | ||
| 17463 | You can put the following code into a separate file and then load it | 17463 | You can put the following code into a separate file and then load it |
| 17464 | from your @file{.emacs} file, or you can include it within your | 17464 | from your @file{.emacs} file, or you can include it within your |
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 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 | ||
| 1051 | This function returns the number of processors, a positive integer. | ||
| 1052 | Each usable thread execution unit counts as a processor. | ||
| 1053 | By default, the count includes the number of available processors, | ||
| 1054 | which 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}. | ||
| 1057 | If the optional argument @var{query} is @code{current}, | ||
| 1058 | this function ignores @env{OMP_NUM_THREADS}; | ||
| 1059 | if @var{query} is @code{all}, this function also counts processors | ||
| 1060 | that 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 |
| 1051 | This function returns the process named @var{name} (a string), or | 1064 | This 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 | ||
| 16520 | As of Org 9.5, a new library =oc.el= provides tooling to handle | 16519 | The =oc.el= library provides tooling to handle citations in Org via |
| 16521 | citations in Org via "citation processors" that offer some or all of | 16520 | "citation processors" that offer some or all of the following |
| 16522 | the following capabilities: | 16521 | capabilities: |
| 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 | ||
| 16529 | The user can configure these with ~org-cite-active-processor~, | 16528 | The 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 | ||
| 16547 | One can then insert and edit citations using ~org-cite-insert~, called | 16548 | One can then insert and edit citations using ~org-cite-insert~, called |
| 16548 | with {{{kbd(M-x org-cite-insert)}}}. | 16549 | with {{{kbd(C-c C-x @)}}}. |
| 16549 | 16550 | ||
| 16550 | A /citation/ requires one or more citation /key(s)/, elements | 16551 | A /citation/ requires one or more citation /key(s)/, elements |
| 16551 | identifying a reference in the bibliography. | 16552 | identifying 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 | ||
| 16573 | The only mandatory elements are: | 16573 | The 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 | ||
| 16608 | The =#+cite_export:= keyword specifies the export processor and the | 16608 | The =CITE_EXPORT= keyword specifies the export processor and the |
| 16609 | citation (and possibly reference) style(s); for example (all arguments | 16609 | citation (and possibly reference) style(s); for example (all arguments |
| 16610 | are optional) | 16610 | are 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 | ||
| 16616 | specifies the "basic" export processor with citations inserted as | 16615 | specifies the "basic" export processor with citations inserted as |
| 16617 | author's name and references indexed by author's names and year; | 16616 | author'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 | ||
| 16623 | specifies the "csl" processor and CSL style, which in this case | 16621 | specifies the "csl" processor and CSL style, which in this case |
| 16624 | defines numeric citations and numeric references according to the | 16622 | defines 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), |
| 16626 | following a typesetting variation putting citations between brackets; | 16624 | following 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 | ||
| 16632 | specifies the "natbib" export processor with a label citation style | 16628 | #+texinfo: @noindent |
| 16629 | specifies the =natbib= export processor with a label citation style | ||
| 16633 | conformant to the Harvard style and the specification of the | 16630 | conformant to the Harvard style and the specification of the |
| 16634 | Wolkers-Kluwer publisher; since it relies on the =bibtex= processor of | 16631 | Wolkers-Kluwer publisher; since it relies on the ~bibtex~ processor of |
| 16635 | your LaTeX installation, it won't export to anything but PDF. | 16632 | your 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. | |||
| 4095 | Make a string appropriate for usage as a visual separator line. | 4095 | Make a string appropriate for usage as a visual separator line. |
| 4096 | 4096 | ||
| 4097 | +++ | 4097 | +++ |
| 4098 | ** New function 'num-processors'. | ||
| 4099 | Return the number of processors on the system. | ||
| 4100 | |||
| 4101 | +++ | ||
| 4098 | ** New function 'object-intervals'. | 4102 | ** New function 'object-intervals'. |
| 4099 | This function returns a copy of the list of intervals (i.e., text | 4103 | This function returns a copy of the list of intervals (i.e., text |
| 4100 | properties) in the object in question (which must either be a string | 4104 | properties) in the object in question (which must either be a string |
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index 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 | |||
| 2378 | endif | 2379 | endif |
| 2379 | ## end gnulib module mktime-internal | 2380 | ## end gnulib module mktime-internal |
| 2380 | 2381 | ||
| 2382 | ## begin gnulib module nproc | ||
| 2383 | ifeq (,$(OMIT_GNULIB_MODULE_nproc)) | ||
| 2384 | |||
| 2385 | libgnu_a_SOURCES += nproc.c | ||
| 2386 | |||
| 2387 | EXTRA_DIST += nproc.h | ||
| 2388 | |||
| 2389 | endif | ||
| 2390 | ## end gnulib module nproc | ||
| 2391 | |||
| 2381 | ## begin gnulib module nstrftime | 2392 | ## begin gnulib module nstrftime |
| 2382 | ifeq (,$(OMIT_GNULIB_MODULE_nstrftime)) | 2393 | ifeq (,$(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. */ | ||
| 68 | static unsigned long | ||
| 69 | num_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. */ | ||
| 205 | static unsigned long int | ||
| 206 | num_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. */ | ||
| 343 | static unsigned long int | ||
| 344 | parse_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 | |||
| 378 | unsigned long int | ||
| 379 | num_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 | ||
| 22 | extern "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 | |||
| 32 | enum 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. */ | ||
| 42 | extern 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 | |||
| 5746 | about certain files that you'd usually rather not save. | 5746 | about certain files that you'd usually rather not save. |
| 5747 | 5747 | ||
| 5748 | This function is called (with no parameters) from the buffer to | 5748 | This function is called (with no parameters) from the buffer to |
| 5749 | be saved." | 5749 | be saved. When the function's symbol has the property |
| 5750 | `save-some-buffers-function', the higher-order function is supposed | ||
| 5751 | to 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. |
| 945 | E.g. can complete M-x lch to list-command-history | 945 | E.g. can complete M-x lch to list-command-history |
| 946 | and C-x C-f ~/sew to ~/src/emacs/work.")) | 946 | and 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'. | ||
| 950 | E.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. |
| 948 | Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS DOC): | 953 | Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS DOC): |
| 949 | where NAME is the name that should be used in `completion-styles', | 954 | where NAME is the name that should be used in `completion-styles', |
| @@ -990,7 +995,8 @@ styles for specific categories, such as files, buffers, etc." | |||
| 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. |
| 995 | Each entry has the shape (CATEGORY . ALIST) where ALIST is | 1001 | Each entry has the shape (CATEGORY . ALIST) where ALIST is |
| 996 | an association list that can specify properties such as: | 1002 | an 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. |
| 1623 | Otherwise, try to complete the minibuffer contents. If | 1632 | Otherwise, 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. | |||
| 1326 | the command \"getconf PATH\". It is recommended to use this | 1326 | the command \"getconf PATH\". It is recommended to use this |
| 1327 | entry on head of this list, because these are the default | 1327 | entry on head of this list, because these are the default |
| 1328 | directories for POSIX compatible commands. On remote hosts which | 1328 | directories for POSIX compatible commands. On remote hosts which |
| 1329 | do not offer the getconf command (like cygwin), the value | 1329 | do not offer the getconf command, the value \"/bin:/usr/bin\" is |
| 1330 | \"/bin:/usr/bin\" is used instead. This entry is represented in | 1330 | used instead. This entry is represented in the list by the |
| 1331 | the list by the special value `tramp-default-remote-path'. | 1331 | special 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, |
| 1334 | as given in your `~/.profile'. This entry is represented in | 1334 | as given in your `~/.profile'. This entry is represented in |
| @@ -4127,8 +4127,8 @@ substitution. SPEC-LIST is a list of char/value pairs used for | |||
| 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." | |||
| 4674 | Send \"yes\" to remote process on confirmation, abort otherwise. | 4672 | Send \"yes\" to remote process on confirmation, abort otherwise. |
| 4675 | See also `tramp-action-yn'." | 4673 | See 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'." | |||
| 4689 | Send \"y\" to remote process on confirmation, abort otherwise. | 4686 | Send \"y\" to remote process on confirmation, abort otherwise. |
| 4690 | See also `tramp-action-yesno'." | 4687 | See 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 | ||
| 154 | There, NAME is the name of a registered citation processor providing export | 153 | There, NAME is the name of a registered citation processor providing export |
| 155 | functionality, as a symbol. BIBLIOGRAPHY-STYLE (resp. CITATION-STYLE) is the | 154 | functionality, as a symbol. BIBLIOGRAPHY-STYLE (respectively CITATION-STYLE) |
| 156 | desired default style to use when printing a bibliography (resp. exporting a | 155 | is the desired default style to use when printing a bibliography (respectively |
| 157 | citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and CITATION-STYLE are | 156 | exporting a citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and |
| 158 | optional. NAME is mandatory. | 157 | CITATION-STYLE are optional. NAME is mandatory. |
| 159 | 158 | ||
| 160 | The export process selects the citation processor associated to the current | 159 | The export process selects the citation processor associated to the current |
| 161 | export back-end, or the most specific back-end the current one is derived from, | 160 | export back-end, or the most specific back-end the current one is derived from, |
| @@ -502,8 +501,8 @@ This function assumes S precedes CITATION." | |||
| 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. |
| 505 | String S contains PUNCT. The function assumes S follows CITATION. | 504 | String S contains PUNCT. INFO is the export state, as a property list. |
| 506 | Parse tree is modified by side-effect." | 505 | The 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 | ||
| 878 | INFO is the export state, as a property list. | 888 | INFO is the export state, as a property list. |
| 879 | 889 | ||
| 890 | Optional argument RULE is the punctuation rule used, as a triplet. When nil, | ||
| 891 | rule is determined according to `org-cite-note-rules', which see. | ||
| 892 | |||
| 880 | Optional argument PUNCT is a list of punctuation marks to be considered. | 893 | Optional argument PUNCT is a list of punctuation marks to be considered. |
| 881 | When nil, it defaults to `org-cite-punctuation-marks'. | 894 | When nil, it defaults to `org-cite-punctuation-marks'. |
| 882 | 895 | ||
| 883 | Parse tree is modified by side-effect. | 896 | Parse tree is modified by side-effect. |
| 884 | 897 | ||
| 885 | Note: when calling both `org-cite-adjust-note' and `org-cite-wrap-citation' on | 898 | Note: when calling both `org-cite-adjust-note' and `org-cite-wrap-citation' on |
| 886 | the same object, call `org-cite-adjust-punctuation' first." | 899 | the 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. |
| 1403 | CONTEXT 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. | ||
| 41 | PATH should be a topic that can be thrown at the man command. | ||
| 42 | If PATH contains extra ::STRING which will use `occur' to search | ||
| 43 | matched 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§ion=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. |
| 13 | Inserted by installing Org or when a release is made." | 13 | Inserted 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) \", | |||
| 3219 | where `help-char' is automatically bound to `help-form-show'. | 3221 | where `help-char' is automatically bound to `help-form-show'. |
| 3220 | 3222 | ||
| 3221 | No confirmation of the answer is requested; a single character is | 3223 | No confirmation of the answer is requested; a single character is |
| 3222 | enough. RET and SPC also means yes, and DEL means no. | 3224 | enough. SPC also means yes, and DEL means no. |
| 3223 | 3225 | ||
| 3224 | To be precise, this function translates user input into responses | 3226 | To be precise, this function translates user input into responses |
| 3225 | by consulting the bindings in `query-replace-map'; see the | 3227 | by 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 | ||
| 2 | dnl Copyright (C) 2009-2021 Free Software Foundation, Inc. | ||
| 3 | dnl This file is free software; the Free Software Foundation | ||
| 4 | dnl gives unlimited permission to copy and/or distribute it, | ||
| 5 | dnl with or without modifications, as long as this notice is preserved. | ||
| 6 | |||
| 7 | AC_DEFUN([gl_NPROC], | ||
| 8 | [ | ||
| 9 | gl_PREREQ_NPROC | ||
| 10 | ]) | ||
| 11 | |||
| 12 | # Prerequisites of lib/nproc.c. | ||
| 13 | AC_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 | |||
| 73 | OMIT_GNULIB_MODULE_futimens = true | 73 | OMIT_GNULIB_MODULE_futimens = true |
| 74 | OMIT_GNULIB_MODULE_utimensat = true | 74 | OMIT_GNULIB_MODULE_utimensat = true |
| 75 | OMIT_GNULIB_MODULE_file-has-acl = true | 75 | OMIT_GNULIB_MODULE_file-has-acl = true |
| 76 | OMIT_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 | ||
| 8216 | DEFUN ("num-processors", Fnum_processors, Snum_processors, 0, 1, 0, | ||
| 8217 | doc: /* Return the number of processors, a positive integer. | ||
| 8218 | Each usable thread execution unit counts as a processor. | ||
| 8219 | By default, count the number of available processors, | ||
| 8220 | overridable via the OMP_NUM_THREADS environment variable. | ||
| 8221 | If optional argument QUERY is `current', ignore OMP_NUM_THREADS. | ||
| 8222 | If 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 | } |
| @@ -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. */ | ||
| 1969 | unsigned long | ||
| 1970 | num_processors (enum nproc_query query) | ||
| 1971 | { | ||
| 1972 | /* We ignore QUERY. */ | ||
| 1973 | return w32_get_nproc (); | ||
| 1974 | } | ||
| 1975 | |||
| 1965 | static void | 1976 | static void |
| 1966 | sample_system_load (ULONGLONG *idle, ULONGLONG *kernel, ULONGLONG *user) | 1977 | sample_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 | ||
| 3881 | DEFUN ("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 | ||
| 3890 | void | 3882 | void |
| 3891 | syms_of_ntproc (void) | 3883 | syms_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. |
| 3927 | Because Windows does not directly pass argv arrays to child processes, | 3917 | Because 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. | ||
| 91 | This variable allows setting `mh-variants' to a limited set for targeted | ||
| 92 | testing. Its value can be different from the normal value when | ||
| 93 | environment variable TEST_MH_PATH is set. By remembering the value, we | ||
| 94 | can 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. |
| 82 | Functions that touch the file system or run MH programs are either | 110 | Functions that touch the file system or run MH programs are either |
| 83 | mocked out or pointed at a test tree. When called from Emacs's batch | 111 | mocked out or pointed at a test tree. Uses `mh-test-utils-setup' to |
| 84 | testing infrastructure, this will use mocks and thus run on systems | 112 | select which." |
| 85 | that do not have any MH variant installed. MH-E developers can | ||
| 86 | install 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. |
| 154 | Call `mh-variant-set' to look through the directories named by | ||
| 155 | envionment variable `TEST_MH_PATH' (default: `mh-path' and `mh-sys-path') | ||
| 156 | to find the MH variant to use, if any. | ||
| 107 | Return the name of the root of the created directory tree, if any." | 157 | Return 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 | |||
| 33 | debug= | ||
| 34 | if [[ "$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 | ||
| 41 | fi | ||
| 42 | |||
| 43 | shopt -s extglob | ||
| 44 | ert_test_list=() | ||
| 45 | for 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 | ||
| 55 | done | ||
| 56 | if [[ ${#ert_test_list[@]} -eq 0 ]]; then | ||
| 57 | # t means true for all tests, runs everything | ||
| 58 | ert_test_list=(t) | ||
| 59 | fi | ||
| 60 | |||
| 61 | # This script is 3 directories down in the Emacs source tree. | ||
| 62 | cd "$(dirname "$0")" | ||
| 63 | cd ../../.. | ||
| 64 | emacs=(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. | ||
| 68 | read -r -a mh_sys_path \ | ||
| 69 | < <("${emacs[@]}" -l mh-e --eval "(princ mh-sys-path)" | sed 's/[()]//g') | ||
| 70 | |||
| 71 | have_done_mocked_variant=false | ||
| 72 | declare -i tests_total=0 tests_passed=0 | ||
| 73 | |||
| 74 | for 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)) | ||
| 93 | done | ||
| 94 | |||
| 95 | if (( tests_total == 0 )); then | ||
| 96 | echo "NO tests run" | ||
| 97 | exit 1 | ||
| 98 | elif (( tests_total == tests_passed )); then | ||
| 99 | echo "All tested variants pass: $tests_passed/$tests_total" | ||
| 100 | else | ||
| 101 | echo "Tested variants passing: $tests_passed/$tests_total," \ | ||
| 102 | "FAILING: $((tests_total - tests_passed))/$tests_total" | ||
| 103 | exit 1 | ||
| 104 | fi | ||
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 |