diff options
| author | Yuuki Harano | 2021-01-10 18:49:51 +0900 |
|---|---|---|
| committer | Yuuki Harano | 2021-01-10 18:49:51 +0900 |
| commit | aac33a8074c41354ffdb1236a342da16dca4a1bc (patch) | |
| tree | 3a99478549f66d3f93a282e29d2c302995a86a49 | |
| parent | 78fd106653a9e4fa7c9c3c9788540e2e15552254 (diff) | |
| parent | 690cf6b8d8b8827f046bc1e24b2e556afeff976c (diff) | |
| download | emacs-aac33a8074c41354ffdb1236a342da16dca4a1bc.tar.gz emacs-aac33a8074c41354ffdb1236a342da16dca4a1bc.zip | |
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk
143 files changed, 1914 insertions, 1075 deletions
diff --git a/Makefile.in b/Makefile.in index e766cb49f99..7ed1b6e004f 100644 --- a/Makefile.in +++ b/Makefile.in | |||
| @@ -976,6 +976,10 @@ else | |||
| 976 | @echo "Maybe you used a release tarfile that lacks tests." | 976 | @echo "Maybe you used a release tarfile that lacks tests." |
| 977 | endif | 977 | endif |
| 978 | 978 | ||
| 979 | test/%: | ||
| 980 | $(MAKE) -C test $* | ||
| 981 | |||
| 982 | |||
| 979 | dist: | 983 | dist: |
| 980 | cd ${srcdir}; ./make-dist | 984 | cd ${srcdir}; ./make-dist |
| 981 | 985 | ||
diff --git a/admin/charsets/cp51932.awk b/admin/charsets/cp51932.awk index c3555095249..22b24af1ef5 100644 --- a/admin/charsets/cp51932.awk +++ b/admin/charsets/cp51932.awk | |||
| @@ -31,7 +31,7 @@ | |||
| 31 | # already been mapped to 1 or 3. | 31 | # already been mapped to 1 or 3. |
| 32 | 32 | ||
| 33 | BEGIN { | 33 | BEGIN { |
| 34 | print ";;; cp51932.el -- translation table for CP51932"; | 34 | print ";;; cp51932.el -- translation table for CP51932 -*- lexical-binding:t -*-"; |
| 35 | print ";;; Automatically generated from CP932-2BYTE.map"; | 35 | print ";;; Automatically generated from CP932-2BYTE.map"; |
| 36 | print "(let ((map"; | 36 | print "(let ((map"; |
| 37 | printf " '(;JISEXT<->UNICODE"; | 37 | printf " '(;JISEXT<->UNICODE"; |
diff --git a/admin/charsets/eucjp-ms.awk b/admin/charsets/eucjp-ms.awk index f6a6748ce51..ca9a317611b 100644 --- a/admin/charsets/eucjp-ms.awk +++ b/admin/charsets/eucjp-ms.awk | |||
| @@ -38,7 +38,7 @@ BEGIN { | |||
| 38 | JISX0208_FROM2 = "/xf5/xa1"; | 38 | JISX0208_FROM2 = "/xf5/xa1"; |
| 39 | JISX0212_FROM = "/x8f/xf3/xf3"; | 39 | JISX0212_FROM = "/x8f/xf3/xf3"; |
| 40 | 40 | ||
| 41 | print ";;; eucjp-ms.el -- translation table for eucJP-ms"; | 41 | print ";;; eucjp-ms.el -- translation table for eucJP-ms -*- lexical-binding:t -*-"; |
| 42 | print ";;; Automatically generated from /usr/share/i18n/charmaps/EUC-JP-MS.gz"; | 42 | print ";;; Automatically generated from /usr/share/i18n/charmaps/EUC-JP-MS.gz"; |
| 43 | print "(let ((map"; | 43 | print "(let ((map"; |
| 44 | print " '(;JISEXT<->UNICODE"; | 44 | print " '(;JISEXT<->UNICODE"; |
diff --git a/admin/last-chance.el b/admin/last-chance.el index fd5b8e9bd7a..e8021129e30 100644 --- a/admin/last-chance.el +++ b/admin/last-chance.el | |||
| @@ -105,18 +105,14 @@ defaulting to the one at point." | |||
| 105 | "Symbol: " obarray | 105 | "Symbol: " obarray |
| 106 | nil nil | 106 | nil nil |
| 107 | one nil one))))) | 107 | one nil one))))) |
| 108 | (let ((default-directory (or (vc-root-dir) | 108 | (with-current-buffer |
| 109 | default-directory))) | 109 | (let ((default-directory (or (vc-root-dir) |
| 110 | (grep (format "%s %s" | 110 | default-directory))) |
| 111 | last-chance-grep-command | 111 | (grep (format "%s %s" |
| 112 | symbol))) | 112 | last-chance-grep-command |
| 113 | (setf (buffer-local-value 'last-chance-symbol | 113 | symbol))) |
| 114 | (process-buffer | 114 | (add-hook 'compilation-finish-functions #'last-chance-cleanup nil t) |
| 115 | (car compilation-in-progress))) | 115 | (setq-local last-chance-symbol symbol))) |
| 116 | symbol)) | ||
| 117 | |||
| 118 | (add-to-list 'compilation-finish-functions | ||
| 119 | 'last-chance-cleanup) | ||
| 120 | 116 | ||
| 121 | (provide 'last-chance) | 117 | (provide 'last-chance) |
| 122 | 118 | ||
diff --git a/admin/nt/dist-build/build-zips.sh b/admin/nt/dist-build/build-zips.sh index 809cbc65cac..4a9a7b596e7 100755 --- a/admin/nt/dist-build/build-zips.sh +++ b/admin/nt/dist-build/build-zips.sh | |||
| @@ -20,7 +20,7 @@ | |||
| 20 | 20 | ||
| 21 | function git_up { | 21 | function git_up { |
| 22 | echo [build] Making git worktree for Emacs $VERSION | 22 | echo [build] Making git worktree for Emacs $VERSION |
| 23 | cd $HOME/emacs-build/git/emacs-$MAJOR_VERSION | 23 | cd $REPO_DIR/emacs-$MAJOR_VERSION |
| 24 | git pull | 24 | git pull |
| 25 | git worktree add ../$BRANCH $BRANCH | 25 | git worktree add ../$BRANCH $BRANCH |
| 26 | 26 | ||
| @@ -54,7 +54,7 @@ function build_zip { | |||
| 54 | if [ ! -f Makefile ] || (($CONFIG)) | 54 | if [ ! -f Makefile ] || (($CONFIG)) |
| 55 | then | 55 | then |
| 56 | echo [build] Configuring Emacs $ARCH | 56 | echo [build] Configuring Emacs $ARCH |
| 57 | ../../../git/$BRANCH/configure \ | 57 | $REPO_DIR/$BRANCH/configure \ |
| 58 | --without-dbus \ | 58 | --without-dbus \ |
| 59 | --host=$HOST --without-compress-install \ | 59 | --host=$HOST --without-compress-install \ |
| 60 | $CACHE \ | 60 | $CACHE \ |
| @@ -88,7 +88,7 @@ function build_installer { | |||
| 88 | ARCH=$1 | 88 | ARCH=$1 |
| 89 | cd $HOME/emacs-build/install/emacs-$VERSION | 89 | cd $HOME/emacs-build/install/emacs-$VERSION |
| 90 | echo [build] Calling makensis in `pwd` | 90 | echo [build] Calling makensis in `pwd` |
| 91 | cp ../../git/$BRANCH/admin/nt/dist-build/emacs.nsi . | 91 | cp $REPO_DIR/$BRANCH/admin/nt/dist-build/emacs.nsi . |
| 92 | 92 | ||
| 93 | makensis -v4 \ | 93 | makensis -v4 \ |
| 94 | -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \ | 94 | -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \ |
| @@ -110,6 +110,10 @@ CONFIG=1 | |||
| 110 | CFLAGS="-O2 -static" | 110 | CFLAGS="-O2 -static" |
| 111 | INSTALL_TARGET="install-strip" | 111 | INSTALL_TARGET="install-strip" |
| 112 | 112 | ||
| 113 | ## The location of the git repo | ||
| 114 | REPO_DIR=$HOME/emacs-build/git/ | ||
| 115 | |||
| 116 | |||
| 113 | while getopts "36gb:hnsiV:" opt; do | 117 | while getopts "36gb:hnsiV:" opt; do |
| 114 | case $opt in | 118 | case $opt in |
| 115 | 3) | 119 | 3) |
diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk index 986d299e666..4ecb233fe7b 100755 --- a/admin/unidata/blocks.awk +++ b/admin/unidata/blocks.awk | |||
| @@ -203,7 +203,7 @@ function name2alias(name , w, w2) { | |||
| 203 | } | 203 | } |
| 204 | 204 | ||
| 205 | END { | 205 | END { |
| 206 | print ";;; charscript.el --- character script table" | 206 | print ";;; charscript.el --- character script table -*- lexical-binding:t -*-" |
| 207 | print ";;; Automatically generated from admin/unidata/Blocks.txt" | 207 | print ";;; Automatically generated from admin/unidata/Blocks.txt" |
| 208 | print "(let (script-list)" | 208 | print "(let (script-list)" |
| 209 | print " (dolist (elt '(" | 209 | print " (dolist (elt '(" |
diff --git a/configure.ac b/configure.ac index 3625c4e856f..815d3c98c3a 100644 --- a/configure.ac +++ b/configure.ac | |||
| @@ -4468,6 +4468,18 @@ TERMCAP_OBJ=tparam.o | |||
| 4468 | if test $TERMINFO = yes; then | 4468 | if test $TERMINFO = yes; then |
| 4469 | AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.]) | 4469 | AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.]) |
| 4470 | TERMCAP_OBJ=terminfo.o | 4470 | TERMCAP_OBJ=terminfo.o |
| 4471 | AC_CACHE_CHECK([whether $LIBS_TERMCAP library defines BC], | ||
| 4472 | [emacs_cv_terminfo_defines_BC], | ||
| 4473 | [OLD_LIBS=$LIBS | ||
| 4474 | LIBS="$LIBS $LIBS_TERMCAP" | ||
| 4475 | AC_LINK_IFELSE([AC_LANG_PROGRAM([[extern char *BC;]], [[return !*BC;]])], | ||
| 4476 | [emacs_cv_terminfo_defines_BC=yes], | ||
| 4477 | [emacs_cv_terminfo_defines_BC=no]) | ||
| 4478 | LIBS=$OLD_LIBS]) | ||
| 4479 | if test "$emacs_cv_terminfo_defines_BC" = yes; then | ||
| 4480 | AC_DEFINE([TERMINFO_DEFINES_BC], 1, [Define to 1 if the | ||
| 4481 | terminfo library defines the variables BC, PC, and UP.]) | ||
| 4482 | fi | ||
| 4471 | fi | 4483 | fi |
| 4472 | if test "X$LIBS_TERMCAP" = "X-lncurses"; then | 4484 | if test "X$LIBS_TERMCAP" = "X-lncurses"; then |
| 4473 | AC_DEFINE(USE_NCURSES, 1, [Define to 1 if you use ncurses.]) | 4485 | AC_DEFINE(USE_NCURSES, 1, [Define to 1 if you use ncurses.]) |
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 1e779ac7054..8e4b0ebfe96 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi | |||
| @@ -424,7 +424,7 @@ move to it and type @key{RET}, to visit the source code. You can also | |||
| 424 | type @key{RET} while point is on any name of a function or variable | 424 | type @key{RET} while point is on any name of a function or variable |
| 425 | which is not underlined, to see help information for that symbol in a | 425 | which is not underlined, to see help information for that symbol in a |
| 426 | help buffer, if any exists. The @code{xref-find-definitions} command, | 426 | help buffer, if any exists. The @code{xref-find-definitions} command, |
| 427 | bound to @key{M-.}, can also be used on any identifier in a backtrace | 427 | bound to @kbd{M-.}, can also be used on any identifier in a backtrace |
| 428 | (@pxref{Looking Up Identifiers,,,emacs, The GNU Emacs Manual}). | 428 | (@pxref{Looking Up Identifiers,,,emacs, The GNU Emacs Manual}). |
| 429 | 429 | ||
| 430 | In backtraces, the tails of long lists and the ends of long strings, | 430 | In backtraces, the tails of long lists and the ends of long strings, |
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 2fd05b73917..298bec5230c 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi | |||
| @@ -545,7 +545,7 @@ brackets. | |||
| 545 | @end group | 545 | @end group |
| 546 | @group | 546 | @group |
| 547 | (single-key-description 'C-mouse-1) | 547 | (single-key-description 'C-mouse-1) |
| 548 | @result{} "<C-mouse-1>" | 548 | @result{} "C-<mouse-1>" |
| 549 | @end group | 549 | @end group |
| 550 | @group | 550 | @group |
| 551 | (single-key-description 'C-mouse-1 t) | 551 | (single-key-description 'C-mouse-1 t) |
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 81139b9e746..f0036f0ccfc 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi | |||
| @@ -348,7 +348,7 @@ default, it makes the following bindings: | |||
| 348 | @item @key{RET} | 348 | @item @key{RET} |
| 349 | @code{exit-minibuffer} | 349 | @code{exit-minibuffer} |
| 350 | 350 | ||
| 351 | @item @key{M-<} | 351 | @item @kbd{M-<} |
| 352 | @code{minibuffer-beginning-of-buffer} | 352 | @code{minibuffer-beginning-of-buffer} |
| 353 | 353 | ||
| 354 | @item @kbd{C-g} | 354 | @item @kbd{C-g} |
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 897b424b187..5cae939b7bf 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi | |||
| @@ -120,9 +120,9 @@ character (i.e., an integer), @code{nil} otherwise. | |||
| 120 | @cindex string creation | 120 | @cindex string creation |
| 121 | 121 | ||
| 122 | The following functions create strings, either from scratch, or by | 122 | The following functions create strings, either from scratch, or by |
| 123 | putting strings together, or by taking them apart. (For functions that | 123 | putting strings together, or by taking them apart. (For functions |
| 124 | create strings based on searching the contents of other strings (like | 124 | that create strings based on the modified contents of other strings, |
| 125 | @code{string-replace} and @code{replace-regexp-in-string}), see | 125 | like @code{string-replace} and @code{replace-regexp-in-string}, see |
| 126 | @ref{Search and Replace}.) | 126 | @ref{Search and Replace}.) |
| 127 | 127 | ||
| 128 | @defun make-string count character &optional multibyte | 128 | @defun make-string count character &optional multibyte |
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index b4bd48771f0..d27053a1799 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi | |||
| @@ -252,7 +252,7 @@ comment and a newline or formfeed ends one. | |||
| 252 | 252 | ||
| 253 | @item Inherit standard syntax: @samp{@@} | 253 | @item Inherit standard syntax: @samp{@@} |
| 254 | This syntax class does not specify a particular syntax. It says to | 254 | This syntax class does not specify a particular syntax. It says to |
| 255 | look in the standard syntax table to find the syntax of this | 255 | look in the parent syntax table to find the syntax of this |
| 256 | character. | 256 | character. |
| 257 | 257 | ||
| 258 | @item Generic comment delimiters: @samp{!} | 258 | @item Generic comment delimiters: @samp{!} |
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index b0906acbad5..f305d1a8ee8 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi | |||
| @@ -2634,6 +2634,12 @@ window and displaying the buffer in that window. It can fail if all | |||
| 2634 | windows are dedicated to other buffers (@pxref{Dedicated Windows}). | 2634 | windows are dedicated to other buffers (@pxref{Dedicated Windows}). |
| 2635 | @end defun | 2635 | @end defun |
| 2636 | 2636 | ||
| 2637 | @defun display-buffer-use-least-recent-window buffer alist | ||
| 2638 | This function is like @code{display-buffer-use-some-window}, but will | ||
| 2639 | not reuse the current window, and will use the least recently | ||
| 2640 | switched-to window. | ||
| 2641 | @end defun | ||
| 2642 | |||
| 2637 | @defun display-buffer-in-direction buffer alist | 2643 | @defun display-buffer-in-direction buffer alist |
| 2638 | This function tries to display @var{buffer} at a location specified by | 2644 | This function tries to display @var{buffer} at a location specified by |
| 2639 | @var{alist}. For this purpose, @var{alist} should contain a | 2645 | @var{alist}. For this purpose, @var{alist} should contain a |
diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index b0254e0824c..7fd9212d714 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi | |||
| @@ -692,14 +692,14 @@ arguments, which will be used when creating the @code{radio-button} or | |||
| 692 | 692 | ||
| 693 | @end table | 693 | @end table |
| 694 | 694 | ||
| 695 | @deffn {User Option} widget-glyph-directory | 695 | @deffn {User Option} widget-image-directory |
| 696 | Directory where glyphs are found. | 696 | Directory where Widget should look for images. |
| 697 | Widget will look here for a file with the same name as specified for the | 697 | Widget will look here for a file with the same name as specified for the |
| 698 | image, with either a @file{.xpm} (if supported) or @file{.xbm} extension. | 698 | image, with either a @file{.xpm} (if supported) or @file{.xbm} extension. |
| 699 | @end deffn | 699 | @end deffn |
| 700 | 700 | ||
| 701 | @deffn{User Option} widget-glyph-enable | 701 | @deffn{User Option} widget-image-enable |
| 702 | If non-@code{nil}, allow glyphs to appear on displays where they are supported. | 702 | If non-@code{nil}, allow images to appear on displays where they are supported. |
| 703 | @end deffn | 703 | @end deffn |
| 704 | 704 | ||
| 705 | 705 | ||
| @@ -212,6 +212,19 @@ This makes debugging Emacs Lisp scripts run in batch mode easier. To | |||
| 212 | get back the old behavior, set the new variable | 212 | get back the old behavior, set the new variable |
| 213 | 'backtrace-on-error-noninteractive' to a nil value. | 213 | 'backtrace-on-error-noninteractive' to a nil value. |
| 214 | 214 | ||
| 215 | ** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast input. | ||
| 216 | This is another attempt to solve the problem of handling high key repeat rate | ||
| 217 | and other "slow scrolling" situations. It is hoped it behaves better | ||
| 218 | than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'. | ||
| 219 | It is not enabled by default. | ||
| 220 | |||
| 221 | +++ | ||
| 222 | ** Modifiers now go outside angle brackets in pretty-printed key bindings. | ||
| 223 | For example, <return> with Control and Meta modifiers is now shown as | ||
| 224 | C-M-<return> instead of <C-M-return>. Either variant can be used as | ||
| 225 | input; functions such as 'kbd' and 'read-kbd-macro' accept both styles | ||
| 226 | as equivalent (they have done so for a long time). | ||
| 227 | |||
| 215 | 228 | ||
| 216 | * Editing Changes in Emacs 28.1 | 229 | * Editing Changes in Emacs 28.1 |
| 217 | 230 | ||
| @@ -360,6 +373,15 @@ disabled entirely. | |||
| 360 | 373 | ||
| 361 | ** Windows | 374 | ** Windows |
| 362 | 375 | ||
| 376 | +++ | ||
| 377 | *** New 'display-buffer' function 'display-buffer-use-least-recent-window' | ||
| 378 | This is like 'display-buffer-use-some-window', but won't reuse the | ||
| 379 | current window, and when called repeatedly will try not to reuse a | ||
| 380 | previously selected window. | ||
| 381 | |||
| 382 | *** New function 'window-bump-use-time'. | ||
| 383 | This updates the use time of a window. | ||
| 384 | |||
| 363 | *** The key prefix 'C-x 4 1' displays next command buffer in the same window. | 385 | *** The key prefix 'C-x 4 1' displays next command buffer in the same window. |
| 364 | It's bound to the command 'same-window-prefix' that requests the buffer | 386 | It's bound to the command 'same-window-prefix' that requests the buffer |
| 365 | of the next command to be displayed in the same window. | 387 | of the next command to be displayed in the same window. |
| @@ -383,11 +405,20 @@ of the next command to be displayed in a new tab. | |||
| 383 | +++ | 405 | +++ |
| 384 | *** New command 'C-x t C-r' to open file read-only in other tab. | 406 | *** New command 'C-x t C-r' to open file read-only in other tab. |
| 385 | 407 | ||
| 408 | --- | ||
| 386 | *** The tab bar is frame-local when 'tab-bar-show' is a number. | 409 | *** The tab bar is frame-local when 'tab-bar-show' is a number. |
| 387 | Show/hide the tab bar independently for each frame, according to the | 410 | Show/hide the tab bar independently for each frame, according to the |
| 388 | value of 'tab-bar-show'. | 411 | value of 'tab-bar-show'. |
| 389 | 412 | ||
| 390 | --- | 413 | --- |
| 414 | *** New command 'toggle-frame-tab-bar'. | ||
| 415 | It can be used to enable/disable the tab bar individually on each frame | ||
| 416 | independently from the value of 'tab-bar-mode' and 'tab-bar-show'. | ||
| 417 | |||
| 418 | --- | ||
| 419 | *** New user option 'tab-bar-tab-name-format-function'. | ||
| 420 | |||
| 421 | --- | ||
| 391 | *** The tabs in the tab line can now be scrolled using horizontal scroll. | 422 | *** The tabs in the tab line can now be scrolled using horizontal scroll. |
| 392 | If your mouse or trackpad supports it, you can now scroll tabs when | 423 | If your mouse or trackpad supports it, you can now scroll tabs when |
| 393 | the mouse pointer is in the tab line by scrolling left or right. | 424 | the mouse pointer is in the tab line by scrolling left or right. |
| @@ -1828,6 +1859,9 @@ also keep the type information of their arguments. Use the | |||
| 1828 | ** CPerl Mode | 1859 | ** CPerl Mode |
| 1829 | 1860 | ||
| 1830 | --- | 1861 | --- |
| 1862 | *** New face 'perl-heredoc', used for heredoc elements. | ||
| 1863 | |||
| 1864 | --- | ||
| 1831 | *** The command 'cperl-set-style' offers the new value "PBP". | 1865 | *** The command 'cperl-set-style' offers the new value "PBP". |
| 1832 | This value customizes Emacs to use the style recommended in Damian | 1866 | This value customizes Emacs to use the style recommended in Damian |
| 1833 | Conway's book "Perl Best Practices" for indentation and formatting | 1867 | Conway's book "Perl Best Practices" for indentation and formatting |
| @@ -2019,6 +2053,12 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. | |||
| 2019 | 'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font', | 2053 | 'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font', |
| 2020 | 'wisent-lex-make-token-table'. | 2054 | 'wisent-lex-make-token-table'. |
| 2021 | 2055 | ||
| 2056 | ** The 'when' argument of `make-obsolete` and related functions is mandatory. | ||
| 2057 | The use of those functions without a 'when' argument was marked | ||
| 2058 | obsolete back in Emacs-23.1. The affected functions are: | ||
| 2059 | make-obsolete, define-obsolete-function-alias, make-obsolete-variable, | ||
| 2060 | define-obsolete-variable-alias. | ||
| 2061 | |||
| 2022 | 2062 | ||
| 2023 | * Lisp Changes in Emacs 28.1 | 2063 | * Lisp Changes in Emacs 28.1 |
| 2024 | 2064 | ||
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 52908d9fb6b..6c9ceb0b5a8 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el | |||
| @@ -2237,8 +2237,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." | |||
| 2237 | ;; not the GNU nor the BSD extensions. As it turns out, this is sufficient | 2237 | ;; not the GNU nor the BSD extensions. As it turns out, this is sufficient |
| 2238 | ;; for .deb packages. | 2238 | ;; for .deb packages. |
| 2239 | 2239 | ||
| 2240 | (autoload 'tar-grind-file-mode "tar-mode") | ||
| 2241 | |||
| 2242 | (defconst archive-ar-file-header-re | 2240 | (defconst archive-ar-file-header-re |
| 2243 | "\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n") | 2241 | "\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n") |
| 2244 | 2242 | ||
diff --git a/lisp/bindings.el b/lisp/bindings.el index b68d55e73d8..187444af664 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; bindings.el --- define standard key bindings and some variables | 1 | ;;; bindings.el --- define standard key bindings and some variables -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985-1987, 1992-1996, 1999-2021 Free Software | 3 | ;; Copyright (C) 1985-1987, 1992-1996, 1999-2021 Free Software |
| 4 | ;; Foundation, Inc. | 4 | ;; Foundation, Inc. |
| @@ -856,7 +856,7 @@ in contrast with \\[forward-char] and \\[backward-char], which | |||
| 856 | see." | 856 | see." |
| 857 | (interactive "^p") | 857 | (interactive "^p") |
| 858 | (if visual-order-cursor-movement | 858 | (if visual-order-cursor-movement |
| 859 | (dotimes (i (if (numberp n) (abs n) 1)) | 859 | (dotimes (_ (if (numberp n) (abs n) 1)) |
| 860 | (move-point-visually (if (and (numberp n) (< n 0)) -1 1))) | 860 | (move-point-visually (if (and (numberp n) (< n 0)) -1 1))) |
| 861 | (if (eq (current-bidi-paragraph-direction) 'left-to-right) | 861 | (if (eq (current-bidi-paragraph-direction) 'left-to-right) |
| 862 | (forward-char n) | 862 | (forward-char n) |
| @@ -874,7 +874,7 @@ in contrast with \\[forward-char] and \\[backward-char], which | |||
| 874 | see." | 874 | see." |
| 875 | (interactive "^p") | 875 | (interactive "^p") |
| 876 | (if visual-order-cursor-movement | 876 | (if visual-order-cursor-movement |
| 877 | (dotimes (i (if (numberp n) (abs n) 1)) | 877 | (dotimes (_ (if (numberp n) (abs n) 1)) |
| 878 | (move-point-visually (if (and (numberp n) (< n 0)) 1 -1))) | 878 | (move-point-visually (if (and (numberp n) (< n 0)) 1 -1))) |
| 879 | (if (eq (current-bidi-paragraph-direction) 'left-to-right) | 879 | (if (eq (current-bidi-paragraph-direction) 'left-to-right) |
| 880 | (backward-char n) | 880 | (backward-char n) |
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index a1135726108..ea79bfa69a0 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el | |||
| @@ -396,7 +396,7 @@ | |||
| 396 | (calc-wrapper | 396 | (calc-wrapper |
| 397 | (setq str (math-showing-full-precision | 397 | (setq str (math-showing-full-precision |
| 398 | (math-format-nice-expr (aref info 8) (frame-width)))) | 398 | (math-format-nice-expr (aref info 8) (frame-width)))) |
| 399 | (calc-edit-mode (list 'calc-embedded-finish-edit info)) | 399 | (calc--edit-mode (lambda () (calc-embedded-finish-edit info))) |
| 400 | (insert str "\n"))) | 400 | (insert str "\n"))) |
| 401 | (calc-show-edit-buffer))) | 401 | (calc-show-edit-buffer))) |
| 402 | 402 | ||
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 7c319c4d654..f4ddb840b50 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el | |||
| @@ -1195,7 +1195,7 @@ calc-set-xor calc-sort calc-subvector calc-tail calc-transpose | |||
| 1195 | calc-unpack calc-unpack-bits calc-vector-find calc-vlength) | 1195 | calc-unpack calc-unpack-bits calc-vector-find calc-vlength) |
| 1196 | 1196 | ||
| 1197 | ("calc-yank" calc-copy-as-kill calc-copy-region-as-kill | 1197 | ("calc-yank" calc-copy-as-kill calc-copy-region-as-kill |
| 1198 | calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode | 1198 | calc-copy-to-buffer calc-edit calc-edit-cancel calc--edit-mode |
| 1199 | calc-kill calc-kill-region calc-yank)))) | 1199 | calc-kill calc-kill-region calc-yank)))) |
| 1200 | 1200 | ||
| 1201 | (defun calc-init-prefixes () | 1201 | (defun calc-init-prefixes () |
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 6ac554ed69c..3097b09b013 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el | |||
| @@ -483,13 +483,13 @@ | |||
| 483 | (interactive) | 483 | (interactive) |
| 484 | (calc-wrapper | 484 | (calc-wrapper |
| 485 | (let ((lang calc-language)) | 485 | (let ((lang calc-language)) |
| 486 | (calc-edit-mode (list 'calc-finish-user-syntax-edit (list 'quote lang)) | 486 | (calc--edit-mode (lambda () (calc-finish-user-syntax-edit lang)) |
| 487 | t | 487 | t |
| 488 | (format "Editing %s-Mode Syntax Table. " | 488 | (format "Editing %s-Mode Syntax Table. " |
| 489 | (cond ((null lang) "Normal") | 489 | (cond ((null lang) "Normal") |
| 490 | ((eq lang 'tex) "TeX") | 490 | ((eq lang 'tex) "TeX") |
| 491 | ((eq lang 'latex) "LaTeX") | 491 | ((eq lang 'latex) "LaTeX") |
| 492 | (t (capitalize (symbol-name lang)))))) | 492 | (t (capitalize (symbol-name lang)))))) |
| 493 | (calc-write-parse-table (cdr (assq lang calc-user-parse-tables)) | 493 | (calc-write-parse-table (cdr (assq lang calc-user-parse-tables)) |
| 494 | lang))) | 494 | lang))) |
| 495 | (calc-show-edit-buffer)) | 495 | (calc-show-edit-buffer)) |
| @@ -696,12 +696,13 @@ | |||
| 696 | (setq cmd (symbol-function cmd))) | 696 | (setq cmd (symbol-function cmd))) |
| 697 | (cond ((or (stringp cmd) | 697 | (cond ((or (stringp cmd) |
| 698 | (and (consp cmd) | 698 | (and (consp cmd) |
| 699 | (eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro))) | 699 | (eq (car-safe (nth 3 cmd)) #'calc-execute-kbd-macro))) |
| 700 | ;; FIXME: Won't (nth 3 cmd) fail when (stringp cmd)? | ||
| 700 | (let* ((mac (elt (nth 1 (nth 3 cmd)) 1)) | 701 | (let* ((mac (elt (nth 1 (nth 3 cmd)) 1)) |
| 701 | (str (edmacro-format-keys mac t)) | 702 | (str (edmacro-format-keys mac t)) |
| 702 | (kys (nth 3 (nth 3 cmd)))) | 703 | (kys (nth 3 (nth 3 cmd)))) |
| 703 | (calc-edit-mode | 704 | (calc--edit-mode |
| 704 | (list 'calc-edit-macro-finish-edit cmdname kys) | 705 | (lambda () (calc-edit-macro-finish-edit cmdname kys)) |
| 705 | t (format (concat | 706 | t (format (concat |
| 706 | "Editing keyboard macro (%s, bound to %s).\n" | 707 | "Editing keyboard macro (%s, bound to %s).\n" |
| 707 | "Original keys: %s \n") | 708 | "Original keys: %s \n") |
| @@ -719,8 +720,8 @@ | |||
| 719 | (if (and defn (calc-valid-formula-func func)) | 720 | (if (and defn (calc-valid-formula-func func)) |
| 720 | (let ((niceexpr (math-format-nice-expr defn (frame-width)))) | 721 | (let ((niceexpr (math-format-nice-expr defn (frame-width)))) |
| 721 | (calc-wrapper | 722 | (calc-wrapper |
| 722 | (calc-edit-mode | 723 | (calc--edit-mode |
| 723 | (list 'calc-finish-formula-edit (list 'quote func)) | 724 | (lambda () (calc-finish-formula-edit func)) |
| 724 | nil | 725 | nil |
| 725 | (format (concat | 726 | (format (concat |
| 726 | "Editing formula (%s, %s, bound to %s).\n" | 727 | "Editing formula (%s, %s, bound to %s).\n" |
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index e6c6337f969..2b317ac3696 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el | |||
| @@ -675,12 +675,12 @@ | |||
| 675 | (entry (calc-top num 'entry)) | 675 | (entry (calc-top num 'entry)) |
| 676 | (expr (car entry)) | 676 | (expr (car entry)) |
| 677 | (sel (or (calc-auto-selection entry) expr)) | 677 | (sel (or (calc-auto-selection entry) expr)) |
| 678 | ) ;; alg | 678 | ;; alg |
| 679 | (let ((str (math-showing-full-precision | 679 | (str (math-showing-full-precision |
| 680 | (math-format-nice-expr sel (frame-width))))) | 680 | (math-format-nice-expr sel (frame-width)))) |
| 681 | (calc-edit-mode (list 'calc-finish-selection-edit | 681 | (csr calc-sel-reselect)) |
| 682 | num (list 'quote sel) calc-sel-reselect)) | 682 | (calc--edit-mode (lambda () (calc-finish-selection-edit num sel csr))) |
| 683 | (insert str "\n")))) | 683 | (insert str "\n"))) |
| 684 | (calc-show-edit-buffer)) | 684 | (calc-show-edit-buffer)) |
| 685 | 685 | ||
| 686 | (defvar calc-original-buffer) | 686 | (defvar calc-original-buffer) |
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index a5e9012dec6..ee29c440fe4 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el | |||
| @@ -437,10 +437,10 @@ | |||
| 437 | (if (eq (car-safe value) 'special-const) | 437 | (if (eq (car-safe value) 'special-const) |
| 438 | (error "%s is a special constant" var)) | 438 | (error "%s is a special constant" var)) |
| 439 | (setq calc-last-edited-variable var) | 439 | (setq calc-last-edited-variable var) |
| 440 | (calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var)) | 440 | (calc--edit-mode (lambda () (calc-finish-stack-edit var)) |
| 441 | t | 441 | t |
| 442 | (format-message | 442 | (format-message |
| 443 | "Editing variable `%s'" (calc-var-name var))) | 443 | "Editing variable `%s'" (calc-var-name var))) |
| 444 | (and value | 444 | (and value |
| 445 | (insert (math-format-nice-expr value (frame-width)) "\n"))))) | 445 | (insert (math-format-nice-expr value (frame-width)) "\n"))))) |
| 446 | (calc-show-edit-buffer)) | 446 | (calc-show-edit-buffer)) |
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 8267340a3ec..e5f05236f3a 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el | |||
| @@ -651,14 +651,14 @@ Interactively, reads the register using `register-read-with-preview'." | |||
| 651 | (if (> n 0) | 651 | (if (> n 0) |
| 652 | (calc-top-list n) | 652 | (calc-top-list n) |
| 653 | (calc-top-list 1 (- n))))))) | 653 | (calc-top-list 1 (- n))))))) |
| 654 | (calc-edit-mode (list 'calc-finish-stack-edit (or flag n)) allow-ret) | 654 | (calc--edit-mode (lambda () (calc-finish-stack-edit (or flag n))) allow-ret) |
| 655 | (while list | 655 | (while list |
| 656 | (insert (car list) "\n") | 656 | (insert (car list) "\n") |
| 657 | (setq list (cdr list))))) | 657 | (setq list (cdr list))))) |
| 658 | (calc-show-edit-buffer)) | 658 | (calc-show-edit-buffer)) |
| 659 | 659 | ||
| 660 | (defun calc-alg-edit (str) | 660 | (defun calc-alg-edit (str) |
| 661 | (calc-edit-mode '(calc-finish-stack-edit 0)) | 661 | (calc--edit-mode (lambda () (calc-finish-stack-edit 0))) |
| 662 | (calc-show-edit-buffer) | 662 | (calc-show-edit-buffer) |
| 663 | (insert str "\n") | 663 | (insert str "\n") |
| 664 | (backward-char 1) | 664 | (backward-char 1) |
| @@ -666,54 +666,47 @@ Interactively, reads the register using `register-read-with-preview'." | |||
| 666 | 666 | ||
| 667 | (defvar calc-edit-mode-map | 667 | (defvar calc-edit-mode-map |
| 668 | (let ((map (make-sparse-keymap))) | 668 | (let ((map (make-sparse-keymap))) |
| 669 | (define-key map "\n" 'calc-edit-finish) | 669 | (define-key map "\n" #'calc-edit-finish) |
| 670 | (define-key map "\r" 'calc-edit-return) | 670 | (define-key map "\r" #'calc-edit-return) |
| 671 | (define-key map "\C-c\C-c" 'calc-edit-finish) | 671 | (define-key map "\C-c\C-c" #'calc-edit-finish) |
| 672 | map) | 672 | map) |
| 673 | "Keymap for use by the calc-edit command.") | 673 | "Keymap for use by the `calc-edit' command.") |
| 674 | 674 | ||
| 675 | (defvar calc-original-buffer) | 675 | (defvar calc-original-buffer nil) |
| 676 | (defvar calc-return-buffer) | 676 | (defvar calc-return-buffer nil) |
| 677 | (defvar calc-one-window) | 677 | (defvar calc-one-window nil) |
| 678 | (defvar calc-edit-handler) | 678 | (defvar calc-edit-handler nil) |
| 679 | (defvar calc-restore-trail) | 679 | (defvar calc-restore-trail nil) |
| 680 | (defvar calc-allow-ret) | 680 | (defvar calc-allow-ret nil) |
| 681 | (defvar calc-edit-top) | 681 | (defvar calc-edit-top nil) |
| 682 | 682 | ||
| 683 | (defun calc-edit-mode (&optional handler allow-ret title) | 683 | (put 'calc-edit-mode 'mode-class 'special) |
| 684 | (define-derived-mode calc-edit-mode nil "Calc Edit" | ||
| 684 | "Calculator editing mode. Press RET, LFD, or C-c C-c to finish. | 685 | "Calculator editing mode. Press RET, LFD, or C-c C-c to finish. |
| 685 | To cancel the edit, simply kill the *Calc Edit* buffer." | 686 | To cancel the edit, simply kill the *Calc Edit* buffer." |
| 686 | (interactive) | 687 | (setq-local buffer-read-only nil) |
| 688 | (setq-local truncate-lines nil)) | ||
| 689 | |||
| 690 | (defun calc--edit-mode (handler &optional allow-ret title) | ||
| 687 | (unless handler | 691 | (unless handler |
| 688 | (error "This command can be used only indirectly through calc-edit")) | 692 | (error "This command can be used only indirectly through calc-edit")) |
| 689 | (let ((oldbuf (current-buffer)) | 693 | (let ((oldbuf (current-buffer)) |
| 690 | (buf (get-buffer-create "*Calc Edit*"))) | 694 | (buf (get-buffer-create "*Calc Edit*"))) |
| 691 | (set-buffer buf) | 695 | (set-buffer buf) |
| 692 | (kill-all-local-variables) | 696 | (calc-edit-mode) |
| 693 | (use-local-map calc-edit-mode-map) | 697 | (setq-local calc-original-buffer oldbuf) |
| 694 | (setq buffer-read-only nil) | 698 | (setq-local calc-return-buffer oldbuf) |
| 695 | (setq truncate-lines nil) | 699 | (setq-local calc-one-window (and (one-window-p t) pop-up-windows)) |
| 696 | (setq major-mode 'calc-edit-mode) | 700 | (setq-local calc-edit-handler handler) |
| 697 | (setq mode-name "Calc Edit") | 701 | (setq-local calc-restore-trail (get-buffer-window (calc-trail-buffer))) |
| 698 | (run-mode-hooks 'calc-edit-mode-hook) | 702 | (setq-local calc-allow-ret allow-ret) |
| 699 | (make-local-variable 'calc-original-buffer) | ||
| 700 | (setq calc-original-buffer oldbuf) | ||
| 701 | (make-local-variable 'calc-return-buffer) | ||
| 702 | (setq calc-return-buffer oldbuf) | ||
| 703 | (make-local-variable 'calc-one-window) | ||
| 704 | (setq calc-one-window (and (one-window-p t) pop-up-windows)) | ||
| 705 | (make-local-variable 'calc-edit-handler) | ||
| 706 | (setq calc-edit-handler handler) | ||
| 707 | (make-local-variable 'calc-restore-trail) | ||
| 708 | (setq calc-restore-trail (get-buffer-window (calc-trail-buffer))) | ||
| 709 | (make-local-variable 'calc-allow-ret) | ||
| 710 | (setq calc-allow-ret allow-ret) | ||
| 711 | (let ((inhibit-read-only t)) | 703 | (let ((inhibit-read-only t)) |
| 712 | (erase-buffer)) | 704 | (erase-buffer)) |
| 713 | (add-hook 'kill-buffer-hook (lambda () | 705 | (add-hook 'kill-buffer-hook (lambda () |
| 714 | (let ((calc-edit-handler nil)) | 706 | (let ((calc-edit-handler nil)) |
| 715 | (calc-edit-finish t)) | 707 | (calc-edit-finish t)) |
| 716 | (message "(Canceled)")) t t) | 708 | (message "(Canceled)")) |
| 709 | t t) | ||
| 717 | (insert (propertize | 710 | (insert (propertize |
| 718 | (concat | 711 | (concat |
| 719 | (or title title "Calc Edit Mode. ") | 712 | (or title title "Calc Edit Mode. ") |
| @@ -721,9 +714,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer." | |||
| 721 | (if allow-ret "" " or RET") | 714 | (if allow-ret "" " or RET") |
| 722 | (format-message " to finish, `C-x k RET' to cancel.\n\n")) | 715 | (format-message " to finish, `C-x k RET' to cancel.\n\n")) |
| 723 | 'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t)) | 716 | 'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t)) |
| 724 | (make-local-variable 'calc-edit-top) | 717 | (setq-local calc-edit-top (point)))) |
| 725 | (setq calc-edit-top (point)))) | ||
| 726 | (put 'calc-edit-mode 'mode-class 'special) | ||
| 727 | 718 | ||
| 728 | (defun calc-show-edit-buffer () | 719 | (defun calc-show-edit-buffer () |
| 729 | (let ((buf (current-buffer))) | 720 | (let ((buf (current-buffer))) |
| @@ -743,24 +734,19 @@ To cancel the edit, simply kill the *Calc Edit* buffer." | |||
| 743 | 734 | ||
| 744 | (defun calc-edit-return () | 735 | (defun calc-edit-return () |
| 745 | (interactive) | 736 | (interactive) |
| 746 | (if (and (boundp 'calc-allow-ret) calc-allow-ret) | 737 | (if calc-allow-ret |
| 747 | (newline) | 738 | (newline) |
| 748 | (calc-edit-finish))) | 739 | (calc-edit-finish))) |
| 749 | 740 | ||
| 750 | ;; The variable calc-edit-disp-trail is local to calc-edit finish, but | 741 | ;; The variable `calc-edit-disp-trail' is local to `calc-edit-finish', but |
| 751 | ;; is used by calc-finish-selection-edit and calc-finish-stack-edit. | 742 | ;; is used by `calc-finish-selection-edit' and `calc-finish-stack-edit'. |
| 752 | (defvar calc-edit-disp-trail) | 743 | (defvar calc-edit-disp-trail) |
| 753 | 744 | ||
| 754 | (defun calc-edit-finish (&optional keep) | 745 | (defun calc-edit-finish (&optional keep) |
| 755 | "Finish calc-edit mode. Parse buffer contents and push them on the stack." | 746 | "Finish `calc-edit' mode. Parse buffer contents and push them on the stack." |
| 756 | (interactive "P") | 747 | (interactive "P") |
| 757 | (message "Working...") | 748 | (message "Working...") |
| 758 | (or (and (boundp 'calc-original-buffer) | 749 | (or (derived-mode-p 'calc-edit-mode) |
| 759 | (boundp 'calc-return-buffer) | ||
| 760 | (boundp 'calc-one-window) | ||
| 761 | (boundp 'calc-edit-handler) | ||
| 762 | (boundp 'calc-restore-trail) | ||
| 763 | (eq major-mode 'calc-edit-mode)) | ||
| 764 | (error "This command is valid only in buffers created by calc-edit")) | 750 | (error "This command is valid only in buffers created by calc-edit")) |
| 765 | (let ((buf (current-buffer)) | 751 | (let ((buf (current-buffer)) |
| 766 | (original calc-original-buffer) | 752 | (original calc-original-buffer) |
| @@ -775,7 +761,11 @@ To cancel the edit, simply kill the *Calc Edit* buffer." | |||
| 775 | (error "Original calculator buffer has been corrupted"))) | 761 | (error "Original calculator buffer has been corrupted"))) |
| 776 | (goto-char calc-edit-top) | 762 | (goto-char calc-edit-top) |
| 777 | (if (buffer-modified-p) | 763 | (if (buffer-modified-p) |
| 778 | (eval calc-edit-handler t)) | 764 | (if (functionp calc-edit-handler) |
| 765 | (funcall calc-edit-handler) | ||
| 766 | (message "Deprecated handler expression in calc-edit-handler: %S" | ||
| 767 | calc-edit-handler) | ||
| 768 | (eval calc-edit-handler t))) | ||
| 779 | (if (and one-window (not (one-window-p t))) | 769 | (if (and one-window (not (one-window-p t))) |
| 780 | (delete-window)) | 770 | (delete-window)) |
| 781 | (if (get-buffer-window return) | 771 | (if (get-buffer-window return) |
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index 29bcd6de2ce..281b89e088f 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el | |||
| @@ -700,7 +700,7 @@ ARG is positive, otherwise off." | |||
| 700 | (let ((appt-active appt-timer)) | 700 | (let ((appt-active appt-timer)) |
| 701 | (setq appt-active (if arg (> (prefix-numeric-value arg) 0) | 701 | (setq appt-active (if arg (> (prefix-numeric-value arg) 0) |
| 702 | (not appt-active))) | 702 | (not appt-active))) |
| 703 | (remove-hook 'write-file-functions #'appt-update-list) | 703 | (remove-hook 'write-file-functions #'appt-update-list 'local) |
| 704 | (or global-mode-string (setq global-mode-string '(""))) | 704 | (or global-mode-string (setq global-mode-string '(""))) |
| 705 | (delq 'appt-mode-string global-mode-string) | 705 | (delq 'appt-mode-string global-mode-string) |
| 706 | (when appt-timer | 706 | (when appt-timer |
| @@ -708,7 +708,7 @@ ARG is positive, otherwise off." | |||
| 708 | (setq appt-timer nil)) | 708 | (setq appt-timer nil)) |
| 709 | (if appt-active | 709 | (if appt-active |
| 710 | (progn | 710 | (progn |
| 711 | (add-hook 'write-file-functions #'appt-update-list) | 711 | (add-hook 'write-file-functions #'appt-update-list nil t) |
| 712 | (setq appt-timer (run-at-time t 60 #'appt-check) | 712 | (setq appt-timer (run-at-time t 60 #'appt-check) |
| 713 | global-mode-string | 713 | global-mode-string |
| 714 | (append global-mode-string '(appt-mode-string))) | 714 | (append global-mode-string '(appt-mode-string))) |
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 5f9a3fa352e..9f0ac38ec75 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el | |||
| @@ -168,7 +168,8 @@ This shell should support pipe redirect syntax." | |||
| 168 | (erase-buffer) | 168 | (erase-buffer) |
| 169 | (setq default-directory rootdir) | 169 | (setq default-directory rootdir) |
| 170 | (let ((cmd (semantic-symref-grep-use-template | 170 | (let ((cmd (semantic-symref-grep-use-template |
| 171 | (file-local-name rootdir) filepattern grepflags greppat))) | 171 | (file-name-as-directory (file-local-name rootdir)) |
| 172 | filepattern grepflags greppat))) | ||
| 172 | (process-file semantic-symref-grep-shell nil b nil | 173 | (process-file semantic-symref-grep-shell nil b nil |
| 173 | shell-command-switch cmd))) | 174 | shell-command-switch cmd))) |
| 174 | (setq ans (semantic-symref-parse-tool-output tool b)) | 175 | (setq ans (semantic-symref-parse-tool-output tool b)) |
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el index 21ed1f96ae6..101246cae6f 100644 --- a/lisp/cedet/srecode/semantic.el +++ b/lisp/cedet/srecode/semantic.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; srecode/semantic.el --- Semantic specific extensions to SRecode. | 1 | ;;; srecode/semantic.el --- Semantic specific extensions to SRecode -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -57,7 +57,7 @@ This class will be used to derive dictionary values.") | |||
| 57 | 57 | ||
| 58 | (cl-defmethod srecode-compound-toString((cp srecode-semantic-tag) | 58 | (cl-defmethod srecode-compound-toString((cp srecode-semantic-tag) |
| 59 | function | 59 | function |
| 60 | dictionary) | 60 | _dictionary) |
| 61 | "Convert the compound dictionary value CP to a string. | 61 | "Convert the compound dictionary value CP to a string. |
| 62 | If FUNCTION is non-nil, then FUNCTION is somehow applied to an | 62 | If FUNCTION is non-nil, then FUNCTION is somehow applied to an |
| 63 | aspect of the compound value." | 63 | aspect of the compound value." |
| @@ -410,7 +410,9 @@ as `function' will leave point where code might be inserted." | |||
| 410 | ;; Insert the template. | 410 | ;; Insert the template. |
| 411 | (let ((endpt (srecode-insert-fcn temp dict nil t))) | 411 | (let ((endpt (srecode-insert-fcn temp dict nil t))) |
| 412 | 412 | ||
| 413 | (run-hook-with-args 'point-insert-fcn tag) | 413 | (if (functionp point-insert-fcn) |
| 414 | (funcall point-insert-fcn tag) | ||
| 415 | (dolist (f point-insert-fcn) (funcall f tag))) | ||
| 414 | ;;(sit-for 1) | 416 | ;;(sit-for 1) |
| 415 | 417 | ||
| 416 | (cond | 418 | (cond |
diff --git a/lisp/composite.el b/lisp/composite.el index 7337605d4a9..6f654df15aa 100644 --- a/lisp/composite.el +++ b/lisp/composite.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; composite.el --- support character composition | 1 | ;;; composite.el --- support character composition -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -593,7 +593,6 @@ All non-spacing characters have this function in | |||
| 593 | (as (lglyph-ascent glyph)) | 593 | (as (lglyph-ascent glyph)) |
| 594 | (de (lglyph-descent glyph)) | 594 | (de (lglyph-descent glyph)) |
| 595 | (ce (/ (+ lb rb) 2)) | 595 | (ce (/ (+ lb rb) 2)) |
| 596 | (w (lglyph-width glyph)) | ||
| 597 | xoff yoff) | 596 | xoff yoff) |
| 598 | (cond | 597 | (cond |
| 599 | ((and class (>= class 200) (<= class 240)) | 598 | ((and class (>= class 200) (<= class 240)) |
| @@ -653,7 +652,8 @@ All non-spacing characters have this function in | |||
| 653 | ((and (= class 0) | 652 | ((and (= class 0) |
| 654 | (eq (get-char-code-property (lglyph-char glyph) | 653 | (eq (get-char-code-property (lglyph-char glyph) |
| 655 | ;; Me = enclosing mark | 654 | ;; Me = enclosing mark |
| 656 | 'general-category) 'Me)) | 655 | 'general-category) |
| 656 | 'Me)) | ||
| 657 | ;; Artificially laying out glyphs in an enclosing | 657 | ;; Artificially laying out glyphs in an enclosing |
| 658 | ;; mark is difficult. All we can do is to adjust | 658 | ;; mark is difficult. All we can do is to adjust |
| 659 | ;; the x-offset and width of the base glyph to | 659 | ;; the x-offset and width of the base glyph to |
| @@ -695,9 +695,7 @@ All non-spacing characters have this function in | |||
| 695 | 695 | ||
| 696 | (defun compose-gstring-for-dotted-circle (gstring direction) | 696 | (defun compose-gstring-for-dotted-circle (gstring direction) |
| 697 | (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle | 697 | (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle |
| 698 | (dc-id (lglyph-code dc)) | ||
| 699 | (fc (lgstring-glyph gstring 1)) ; glyph of the following char | 698 | (fc (lgstring-glyph gstring 1)) ; glyph of the following char |
| 700 | (fc-id (lglyph-code fc)) | ||
| 701 | (gstr (and nil (font-shape-gstring gstring direction)))) | 699 | (gstr (and nil (font-shape-gstring gstring direction)))) |
| 702 | (if (and gstr | 700 | (if (and gstr |
| 703 | (or (= (lgstring-glyph-len gstr) 1) | 701 | (or (= (lgstring-glyph-len gstr) 1) |
diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 7d9d1fe13ae..5dcb2842a21 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; cus-face.el --- customization support for faces | 1 | ;;; cus-face.el --- customization support for faces -*- lexical-binding: t; -*- |
| 2 | ;; | 2 | ;; |
| 3 | ;; Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc. |
| 4 | ;; | 4 | ;; |
diff --git a/lisp/custom.el b/lisp/custom.el index dfa8539c44f..d9d0898dcb7 100644 --- a/lisp/custom.el +++ b/lisp/custom.el | |||
| @@ -161,7 +161,9 @@ set to nil, as the value is no longer rogue." | |||
| 161 | ;; Whether automatically buffer-local. | 161 | ;; Whether automatically buffer-local. |
| 162 | buffer-local) | 162 | buffer-local) |
| 163 | (unless (memq :group args) | 163 | (unless (memq :group args) |
| 164 | (custom-add-to-group (custom-current-group) symbol 'custom-variable)) | 164 | (let ((cg (custom-current-group))) |
| 165 | (when cg | ||
| 166 | (custom-add-to-group cg symbol 'custom-variable)))) | ||
| 165 | (while args | 167 | (while args |
| 166 | (let ((keyword (pop args))) | 168 | (let ((keyword (pop args))) |
| 167 | (unless (symbolp keyword) | 169 | (unless (symbolp keyword) |
| @@ -525,7 +527,9 @@ If no such group is found, return nil." | |||
| 525 | "For customization option SYMBOL, handle keyword arguments ARGS. | 527 | "For customization option SYMBOL, handle keyword arguments ARGS. |
| 526 | Third argument TYPE is the custom option type." | 528 | Third argument TYPE is the custom option type." |
| 527 | (unless (memq :group args) | 529 | (unless (memq :group args) |
| 528 | (custom-add-to-group (custom-current-group) symbol type)) | 530 | (let ((cg (custom-current-group))) |
| 531 | (when cg | ||
| 532 | (custom-add-to-group cg symbol type)))) | ||
| 529 | (while args | 533 | (while args |
| 530 | (let ((arg (car args))) | 534 | (let ((arg (car args))) |
| 531 | (setq args (cdr args)) | 535 | (setq args (cdr args)) |
diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 6de14b1d297..a7fc8f0a76e 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; disp-table.el --- functions for dealing with char tables | 1 | ;;; disp-table.el --- functions for dealing with char tables -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1987, 1994-1995, 1999, 2001-2021 Free Software | 3 | ;; Copyright (C) 1987, 1994-1995, 1999, 2001-2021 Free Software |
| 4 | ;; Foundation, Inc. | 4 | ;; Foundation, Inc. |
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el index 5d4aa7843f1..255edd0f371 100644 --- a/lisp/dos-fns.el +++ b/lisp/dos-fns.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; dos-fns.el --- MS-Dos specific functions | 1 | ;;; dos-fns.el --- MS-Dos specific functions -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1991, 1993, 1995-1996, 2001-2021 Free Software | 3 | ;; Copyright (C) 1991, 1993, 1995-1996, 2001-2021 Free Software |
| 4 | ;; Foundation, Inc. | 4 | ;; Foundation, Inc. |
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index e902491446c..cf753214624 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms | 1 | ;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -154,13 +154,15 @@ when writing the file." | |||
| 154 | ;; FIXME: Can't we use find-file-literally for the same purposes? | 154 | ;; FIXME: Can't we use find-file-literally for the same purposes? |
| 155 | (interactive "FFind file binary: ") | 155 | (interactive "FFind file binary: ") |
| 156 | (let ((coding-system-for-read 'no-conversion)) ;; FIXME: undecided-unix? | 156 | (let ((coding-system-for-read 'no-conversion)) ;; FIXME: undecided-unix? |
| 157 | (find-file filename))) | 157 | (with-suppressed-warnings ((interactive-only find-file)) |
| 158 | (find-file filename)))) | ||
| 158 | 159 | ||
| 159 | (defun find-file-text (filename) | 160 | (defun find-file-text (filename) |
| 160 | "Visit file FILENAME and treat it as a text file." | 161 | "Visit file FILENAME and treat it as a text file." |
| 161 | (interactive "FFind file text: ") | 162 | (interactive "FFind file text: ") |
| 162 | (let ((coding-system-for-read 'undecided-dos)) | 163 | (let ((coding-system-for-read 'undecided-dos)) |
| 163 | (find-file filename))) | 164 | (with-suppressed-warnings ((interactive-only find-file)) |
| 165 | (find-file filename)))) | ||
| 164 | 166 | ||
| 165 | (defun w32-find-file-not-found-set-buffer-file-coding-system () | 167 | (defun w32-find-file-not-found-set-buffer-file-coding-system () |
| 166 | (with-current-buffer (current-buffer) | 168 | (with-current-buffer (current-buffer) |
| @@ -261,6 +263,8 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." | |||
| 261 | :group 'dos-fns | 263 | :group 'dos-fns |
| 262 | :group 'w32) | 264 | :group 'w32) |
| 263 | 265 | ||
| 266 | (defvar w32-quote-process-args) | ||
| 267 | |||
| 264 | ;; Function to actually send data to the printer port. | 268 | ;; Function to actually send data to the printer port. |
| 265 | ;; Supports writing directly, and using various programs. | 269 | ;; Supports writing directly, and using various programs. |
| 266 | (defun w32-direct-print-region-helper (printer | 270 | (defun w32-direct-print-region-helper (printer |
diff --git a/lisp/electric.el b/lisp/electric.el index 506e9aa0f7c..6701a36d8bb 100644 --- a/lisp/electric.el +++ b/lisp/electric.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; electric.el --- window maker and Command loop for `electric' modes | 1 | ;;; electric.el --- window maker and Command loop for `electric' modes -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985-1986, 1995, 2001-2021 Free Software Foundation, | 3 | ;; Copyright (C) 1985-1986, 1995, 2001-2021 Free Software Foundation, |
| 4 | ;; Inc. | 4 | ;; Inc. |
| @@ -385,6 +385,8 @@ If multiple rules match, only first one is executed.") | |||
| 385 | (when electric-layout-mode | 385 | (when electric-layout-mode |
| 386 | (electric-layout-post-self-insert-function-1))) | 386 | (electric-layout-post-self-insert-function-1))) |
| 387 | 387 | ||
| 388 | (defvar electric-pair-open-newline-between-pairs) | ||
| 389 | |||
| 388 | ;; for edebug's sake, a separate function | 390 | ;; for edebug's sake, a separate function |
| 389 | (defun electric-layout-post-self-insert-function-1 () | 391 | (defun electric-layout-post-self-insert-function-1 () |
| 390 | (let* ((pos (electric--after-char-pos)) | 392 | (let* ((pos (electric--after-char-pos)) |
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 1786b5cd6a8..ec7492dd4b1 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el | |||
| @@ -220,16 +220,27 @@ expression, in which case we want to handle forms differently." | |||
| 220 | 220 | ||
| 221 | ;; Convert defcustom to less space-consuming data. | 221 | ;; Convert defcustom to less space-consuming data. |
| 222 | ((eq car 'defcustom) | 222 | ((eq car 'defcustom) |
| 223 | (let ((varname (car-safe (cdr-safe form))) | 223 | (let* ((varname (car-safe (cdr-safe form))) |
| 224 | (init (car-safe (cdr-safe (cdr-safe form)))) | 224 | (props (nthcdr 4 form)) |
| 225 | (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form))))) | 225 | (initializer (plist-get props :initialize)) |
| 226 | ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))) | 226 | (init (car-safe (cdr-safe (cdr-safe form)))) |
| 227 | ) | 227 | (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form))))) |
| 228 | ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))) | ||
| 229 | ) | ||
| 228 | `(progn | 230 | `(progn |
| 229 | (defvar ,varname ,init ,doc) | 231 | ,(if (not (member initializer '(nil 'custom-initialize-default |
| 232 | #'custom-initialize-default | ||
| 233 | 'custom-initialize-reset | ||
| 234 | #'custom-initialize-reset))) | ||
| 235 | form | ||
| 236 | `(defvar ,varname ,init ,doc)) | ||
| 237 | ;; When we include the complete `form', this `custom-autoload' | ||
| 238 | ;; is not indispensable, but it still helps in case the `defcustom' | ||
| 239 | ;; doesn't specify its group explicitly, and probably in a few other | ||
| 240 | ;; corner cases. | ||
| 230 | (custom-autoload ',varname ,file | 241 | (custom-autoload ',varname ,file |
| 231 | ,(condition-case nil | 242 | ,(condition-case nil |
| 232 | (null (cadr (memq :set form))) | 243 | (null (plist-get props :set)) |
| 233 | (error nil)))))) | 244 | (error nil)))))) |
| 234 | 245 | ||
| 235 | ((eq car 'defgroup) | 246 | ((eq car 'defgroup) |
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 8334c09bf9f..0f8dd5a2842 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el | |||
| @@ -372,7 +372,7 @@ convention was modified." | |||
| 372 | (puthash (indirect-function function) signature | 372 | (puthash (indirect-function function) signature |
| 373 | advertised-signature-table)) | 373 | advertised-signature-table)) |
| 374 | 374 | ||
| 375 | (defun make-obsolete (obsolete-name current-name &optional when) | 375 | (defun make-obsolete (obsolete-name current-name when) |
| 376 | "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete. | 376 | "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete. |
| 377 | OBSOLETE-NAME should be a function name or macro name (a symbol). | 377 | OBSOLETE-NAME should be a function name or macro name (a symbol). |
| 378 | 378 | ||
| @@ -381,17 +381,14 @@ If CURRENT-NAME is a string, that is the `use instead' message | |||
| 381 | \(it should end with a period, and not start with a capital). | 381 | \(it should end with a period, and not start with a capital). |
| 382 | WHEN should be a string indicating when the function | 382 | WHEN should be a string indicating when the function |
| 383 | was first made obsolete, for example a date or a release number." | 383 | was first made obsolete, for example a date or a release number." |
| 384 | (declare (advertised-calling-convention | ||
| 385 | ;; New code should always provide the `when' argument. | ||
| 386 | (obsolete-name current-name when) "23.1")) | ||
| 387 | (put obsolete-name 'byte-obsolete-info | 384 | (put obsolete-name 'byte-obsolete-info |
| 388 | ;; The second entry used to hold the `byte-compile' handler, but | 385 | ;; The second entry used to hold the `byte-compile' handler, but |
| 389 | ;; is not used any more nowadays. | 386 | ;; is not used any more nowadays. |
| 390 | (purecopy (list current-name nil when))) | 387 | (purecopy (list current-name nil when))) |
| 391 | obsolete-name) | 388 | obsolete-name) |
| 392 | 389 | ||
| 393 | (defmacro define-obsolete-function-alias (obsolete-name current-name | 390 | (defmacro define-obsolete-function-alias ( obsolete-name current-name when |
| 394 | &optional when docstring) | 391 | &optional docstring) |
| 395 | "Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete. | 392 | "Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete. |
| 396 | 393 | ||
| 397 | \(define-obsolete-function-alias \\='old-fun \\='new-fun \"22.1\" \"old-fun's doc.\") | 394 | \(define-obsolete-function-alias \\='old-fun \\='new-fun \"22.1\" \"old-fun's doc.\") |
| @@ -405,15 +402,13 @@ WHEN should be a string indicating when the function was first | |||
| 405 | made obsolete, for example a date or a release number. | 402 | made obsolete, for example a date or a release number. |
| 406 | 403 | ||
| 407 | See the docstrings of `defalias' and `make-obsolete' for more details." | 404 | See the docstrings of `defalias' and `make-obsolete' for more details." |
| 408 | (declare (doc-string 4) | 405 | (declare (doc-string 4)) |
| 409 | (advertised-calling-convention | ||
| 410 | ;; New code should always provide the `when' argument. | ||
| 411 | (obsolete-name current-name when &optional docstring) "23.1")) | ||
| 412 | `(progn | 406 | `(progn |
| 413 | (defalias ,obsolete-name ,current-name ,docstring) | 407 | (defalias ,obsolete-name ,current-name ,docstring) |
| 414 | (make-obsolete ,obsolete-name ,current-name ,when))) | 408 | (make-obsolete ,obsolete-name ,current-name ,when))) |
| 415 | 409 | ||
| 416 | (defun make-obsolete-variable (obsolete-name current-name &optional when access-type) | 410 | (defun make-obsolete-variable ( obsolete-name current-name when |
| 411 | &optional access-type) | ||
| 417 | "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. | 412 | "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. |
| 418 | The warning will say that CURRENT-NAME should be used instead. | 413 | The warning will say that CURRENT-NAME should be used instead. |
| 419 | If CURRENT-NAME is a string, that is the `use instead' message. | 414 | If CURRENT-NAME is a string, that is the `use instead' message. |
| @@ -421,16 +416,13 @@ WHEN should be a string indicating when the variable | |||
| 421 | was first made obsolete, for example a date or a release number. | 416 | was first made obsolete, for example a date or a release number. |
| 422 | ACCESS-TYPE if non-nil should specify the kind of access that will trigger | 417 | ACCESS-TYPE if non-nil should specify the kind of access that will trigger |
| 423 | obsolescence warnings; it can be either `get' or `set'." | 418 | obsolescence warnings; it can be either `get' or `set'." |
| 424 | (declare (advertised-calling-convention | ||
| 425 | ;; New code should always provide the `when' argument. | ||
| 426 | (obsolete-name current-name when &optional access-type) "23.1")) | ||
| 427 | (put obsolete-name 'byte-obsolete-variable | 419 | (put obsolete-name 'byte-obsolete-variable |
| 428 | (purecopy (list current-name access-type when))) | 420 | (purecopy (list current-name access-type when))) |
| 429 | obsolete-name) | 421 | obsolete-name) |
| 430 | 422 | ||
| 431 | 423 | ||
| 432 | (defmacro define-obsolete-variable-alias (obsolete-name current-name | 424 | (defmacro define-obsolete-variable-alias ( obsolete-name current-name when |
| 433 | &optional when docstring) | 425 | &optional docstring) |
| 434 | "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete. | 426 | "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete. |
| 435 | 427 | ||
| 436 | WHEN should be a string indicating when the variable was first | 428 | WHEN should be a string indicating when the variable was first |
| @@ -459,10 +451,7 @@ For the benefit of Customize, if OBSOLETE-NAME has | |||
| 459 | any of the following properties, they are copied to | 451 | any of the following properties, they are copied to |
| 460 | CURRENT-NAME, if it does not already have them: | 452 | CURRENT-NAME, if it does not already have them: |
| 461 | `saved-value', `saved-variable-comment'." | 453 | `saved-value', `saved-variable-comment'." |
| 462 | (declare (doc-string 4) | 454 | (declare (doc-string 4)) |
| 463 | (advertised-calling-convention | ||
| 464 | ;; New code should always provide the `when' argument. | ||
| 465 | (obsolete-name current-name when &optional docstring) "23.1")) | ||
| 466 | `(progn | 455 | `(progn |
| 467 | (defvaralias ,obsolete-name ,current-name ,docstring) | 456 | (defvaralias ,obsolete-name ,current-name ,docstring) |
| 468 | ;; See Bug#4706. | 457 | ;; See Bug#4706. |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 76457814acd..360da6b6ba6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -3441,10 +3441,11 @@ for symbols generated by the byte compiler itself." | |||
| 3441 | (and od | 3441 | (and od |
| 3442 | (not (memq var byte-compile-not-obsolete-vars)) | 3442 | (not (memq var byte-compile-not-obsolete-vars)) |
| 3443 | (not (memq var byte-compile-global-not-obsolete-vars)) | 3443 | (not (memq var byte-compile-global-not-obsolete-vars)) |
| 3444 | (or (pcase (nth 1 od) | 3444 | (not (memq var byte-compile-lexical-variables)) |
| 3445 | ('set (not (eq access-type 'reference))) | 3445 | (pcase (nth 1 od) |
| 3446 | ('get (eq access-type 'reference)) | 3446 | ('set (not (eq access-type 'reference))) |
| 3447 | (_ t))))) | 3447 | ('get (eq access-type 'reference)) |
| 3448 | (_ t)))) | ||
| 3448 | (byte-compile-warn-obsolete var)))) | 3449 | (byte-compile-warn-obsolete var)))) |
| 3449 | 3450 | ||
| 3450 | (defsubst byte-compile-dynamic-variable-op (base-op var) | 3451 | (defsubst byte-compile-dynamic-variable-op (base-op var) |
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 19dd54c8645..8e36dbe4a36 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el | |||
| @@ -304,15 +304,6 @@ the specializer used will be the one returned by BODY." | |||
| 304 | (lambda ,args ,@body)))) | 304 | (lambda ,args ,@body)))) |
| 305 | 305 | ||
| 306 | (eval-and-compile ;Needed while compiling the cl-defmethod calls below! | 306 | (eval-and-compile ;Needed while compiling the cl-defmethod calls below! |
| 307 | (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el. | ||
| 308 | "Check which of the symbols VARS appear in SEXP." | ||
| 309 | (let ((res '())) | ||
| 310 | (while (consp sexp) | ||
| 311 | (dolist (var (cl--generic-fgrep vars (pop sexp))) | ||
| 312 | (unless (memq var res) (push var res)))) | ||
| 313 | (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) | ||
| 314 | res)) | ||
| 315 | |||
| 316 | (defun cl--generic-split-args (args) | 307 | (defun cl--generic-split-args (args) |
| 317 | "Return (SPEC-ARGS . PLAIN-ARGS)." | 308 | "Return (SPEC-ARGS . PLAIN-ARGS)." |
| 318 | (let ((plain-args ()) | 309 | (let ((plain-args ()) |
| @@ -375,11 +366,11 @@ the specializer used will be the one returned by BODY." | |||
| 375 | ;; is used. | 366 | ;; is used. |
| 376 | ;; FIXME: Also, optimize the case where call-next-method is | 367 | ;; FIXME: Also, optimize the case where call-next-method is |
| 377 | ;; only called with explicit arguments. | 368 | ;; only called with explicit arguments. |
| 378 | (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody))) | 369 | (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody))) |
| 379 | (cons (not (not uses-cnm)) | 370 | (cons (not (not uses-cnm)) |
| 380 | `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) | 371 | `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) |
| 381 | ,@(car parsed-body) | 372 | ,@(car parsed-body) |
| 382 | ,(if (not (memq nmp uses-cnm)) | 373 | ,(if (not (assq nmp uses-cnm)) |
| 383 | nbody | 374 | nbody |
| 384 | `(let ((,nmp (lambda () | 375 | `(let ((,nmp (lambda () |
| 385 | (cl--generic-isnot-nnm-p ,cnm)))) | 376 | (cl--generic-isnot-nnm-p ,cnm)))) |
| @@ -617,11 +608,11 @@ The set of acceptable TYPEs (also called \"specializers\") is defined | |||
| 617 | (lambda (,@fixedargs &rest args) | 608 | (lambda (,@fixedargs &rest args) |
| 618 | (let ,bindings | 609 | (let ,bindings |
| 619 | (apply (cl--generic-with-memoization | 610 | (apply (cl--generic-with-memoization |
| 620 | (gethash ,tag-exp method-cache) | 611 | (gethash ,tag-exp method-cache) |
| 621 | (cl--generic-cache-miss | 612 | (cl--generic-cache-miss |
| 622 | generic ',dispatch-arg dispatches-left methods | 613 | generic ',dispatch-arg dispatches-left methods |
| 623 | ,(if (cdr typescodes) | 614 | ,(if (cdr typescodes) |
| 624 | `(append ,@typescodes) (car typescodes)))) | 615 | `(append ,@typescodes) (car typescodes)))) |
| 625 | ,@fixedargs args))))))))) | 616 | ,@fixedargs args))))))))) |
| 626 | 617 | ||
| 627 | (defun cl--generic-make-function (generic) | 618 | (defun cl--generic-make-function (generic) |
| @@ -1110,7 +1101,8 @@ These match if the argument is a cons cell whose car is `eql' to VAL." | |||
| 1110 | (if (not (eq (car-safe specializer) 'head)) | 1101 | (if (not (eq (car-safe specializer) 'head)) |
| 1111 | (cl-call-next-method) | 1102 | (cl-call-next-method) |
| 1112 | (cl--generic-with-memoization | 1103 | (cl--generic-with-memoization |
| 1113 | (gethash (cadr specializer) cl--generic-head-used) specializer) | 1104 | (gethash (cadr specializer) cl--generic-head-used) |
| 1105 | specializer) | ||
| 1114 | (list cl--generic-head-generalizer))) | 1106 | (list cl--generic-head-generalizer))) |
| 1115 | 1107 | ||
| 1116 | (cl--generic-prefill-dispatchers 0 (head eql)) | 1108 | (cl--generic-prefill-dispatchers 0 (head eql)) |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 1cb195d1296..c2bf02ccece 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -2060,10 +2060,99 @@ Like `cl-flet' but the definitions can refer to previous ones. | |||
| 2060 | ((null (cdr bindings)) `(cl-flet ,bindings ,@body)) | 2060 | ((null (cdr bindings)) `(cl-flet ,bindings ,@body)) |
| 2061 | (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body))))) | 2061 | (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body))))) |
| 2062 | 2062 | ||
| 2063 | (defun cl--self-tco (var fargs body) | ||
| 2064 | ;; This tries to "optimize" tail calls for the specific case | ||
| 2065 | ;; of recursive self-calls by replacing them with a `while' loop. | ||
| 2066 | ;; It is quite far from a general tail-call optimization, since it doesn't | ||
| 2067 | ;; even handle mutually recursive functions. | ||
| 2068 | (letrec | ||
| 2069 | ((done nil) ;; Non-nil if some TCO happened. | ||
| 2070 | (retvar (make-symbol "retval")) | ||
| 2071 | (ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s | ||
| 2072 | (make-symbol (symbol-name s)))) | ||
| 2073 | fargs)) | ||
| 2074 | (opt-exps (lambda (exps) ;; `exps' is in tail position! | ||
| 2075 | (append (butlast exps) | ||
| 2076 | (list (funcall opt (car (last exps))))))) | ||
| 2077 | (opt | ||
| 2078 | (lambda (exp) ;; `exp' is in tail position! | ||
| 2079 | (pcase exp | ||
| 2080 | ;; FIXME: Optimize `apply'? | ||
| 2081 | (`(funcall ,(pred (eq var)) . ,aargs) | ||
| 2082 | ;; This is a self-recursive call in tail position. | ||
| 2083 | (let ((sets nil) | ||
| 2084 | (fargs ofargs)) | ||
| 2085 | (while fargs | ||
| 2086 | (pcase (pop fargs) | ||
| 2087 | ('&rest | ||
| 2088 | (push (pop fargs) sets) | ||
| 2089 | (push `(list . ,aargs) sets) | ||
| 2090 | ;; (cl-assert (null fargs)) | ||
| 2091 | ) | ||
| 2092 | ('&optional nil) | ||
| 2093 | (farg | ||
| 2094 | (push farg sets) | ||
| 2095 | (push (pop aargs) sets)))) | ||
| 2096 | (setq done t) | ||
| 2097 | `(progn (setq . ,(nreverse sets)) | ||
| 2098 | :recurse))) | ||
| 2099 | (`(progn . ,exps) `(progn . ,(funcall opt-exps exps))) | ||
| 2100 | (`(if ,cond ,then . ,else) | ||
| 2101 | `(if ,cond ,(funcall opt then) . ,(funcall opt-exps else))) | ||
| 2102 | (`(cond . ,conds) | ||
| 2103 | (let ((cs '())) | ||
| 2104 | (while conds | ||
| 2105 | (pcase (pop conds) | ||
| 2106 | (`(,exp) | ||
| 2107 | (push (if conds | ||
| 2108 | ;; This returns the value of `exp' but it's | ||
| 2109 | ;; only in tail position if it's the | ||
| 2110 | ;; last condition. | ||
| 2111 | `((setq ,retvar ,exp) nil) | ||
| 2112 | `(,(funcall opt exp))) | ||
| 2113 | cs)) | ||
| 2114 | (exps | ||
| 2115 | (push (funcall opt-exps exps) cs)))) | ||
| 2116 | (if (eq t (caar cs)) | ||
| 2117 | `(cond . ,(nreverse cs)) | ||
| 2118 | `(cond ,@(nreverse cs) (t (setq ,retvar nil)))))) | ||
| 2119 | ((and `(,(or 'let 'let*) ,bindings . ,exps) | ||
| 2120 | (guard | ||
| 2121 | ;; Note: it's OK for this `let' to shadow any | ||
| 2122 | ;; of the formal arguments since we will only | ||
| 2123 | ;; setq the fresh new `ofargs' vars instead ;-) | ||
| 2124 | (let ((shadowings | ||
| 2125 | (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))) | ||
| 2126 | ;; If `var' is shadowed, then it clearly can't be | ||
| 2127 | ;; tail-called any more. | ||
| 2128 | (not (memq var shadowings))))) | ||
| 2129 | `(,(car exp) ,bindings . ,(funcall opt-exps exps))) | ||
| 2130 | (_ | ||
| 2131 | `(progn (setq ,retvar ,exp) nil)))))) | ||
| 2132 | |||
| 2133 | (let ((optimized-body (funcall opt-exps body))) | ||
| 2134 | (if (not done) | ||
| 2135 | (cons fargs body) | ||
| 2136 | ;; We use two sets of vars: `ofargs' and `fargs' because we need | ||
| 2137 | ;; to be careful that if a closure captures a formal argument | ||
| 2138 | ;; in one iteration, it needs to capture a different binding | ||
| 2139 | ;; then that of other iterations, e.g. | ||
| 2140 | (cons | ||
| 2141 | ofargs | ||
| 2142 | `((let (,retvar) | ||
| 2143 | (while (let ,(delq nil | ||
| 2144 | (cl-mapcar | ||
| 2145 | (lambda (a oa) | ||
| 2146 | (unless (memq a cl--lambda-list-keywords) | ||
| 2147 | (list a oa))) | ||
| 2148 | fargs ofargs)) | ||
| 2149 | . ,optimized-body)) | ||
| 2150 | ,retvar))))))) | ||
| 2151 | |||
| 2063 | ;;;###autoload | 2152 | ;;;###autoload |
| 2064 | (defmacro cl-labels (bindings &rest body) | 2153 | (defmacro cl-labels (bindings &rest body) |
| 2065 | "Make local (recursive) function definitions. | 2154 | "Make local (recursive) function definitions. |
| 2066 | Each definition can take the form (FUNC ARGLIST BODY...) where | 2155 | +BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where |
| 2067 | FUNC is the function name, ARGLIST its arguments, and BODY the | 2156 | FUNC is the function name, ARGLIST its arguments, and BODY the |
| 2068 | forms of the function body. FUNC is defined in any BODY, as well | 2157 | forms of the function body. FUNC is defined in any BODY, as well |
| 2069 | as FORM, so you can write recursive and mutually recursive | 2158 | as FORM, so you can write recursive and mutually recursive |
| @@ -2075,17 +2164,33 @@ details. | |||
| 2075 | (let ((binds ()) (newenv macroexpand-all-environment)) | 2164 | (let ((binds ()) (newenv macroexpand-all-environment)) |
| 2076 | (dolist (binding bindings) | 2165 | (dolist (binding bindings) |
| 2077 | (let ((var (make-symbol (format "--cl-%s--" (car binding))))) | 2166 | (let ((var (make-symbol (format "--cl-%s--" (car binding))))) |
| 2078 | (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) | 2167 | (push (cons var (cdr binding)) binds) |
| 2079 | (push (cons (car binding) | 2168 | (push (cons (car binding) |
| 2080 | (lambda (&rest args) | 2169 | (lambda (&rest args) |
| 2081 | (if (eq (car args) cl--labels-magic) | 2170 | (if (eq (car args) cl--labels-magic) |
| 2082 | (list cl--labels-magic var) | 2171 | (list cl--labels-magic var) |
| 2083 | (cl-list* 'funcall var args)))) | 2172 | (cl-list* 'funcall var args)))) |
| 2084 | newenv))) | 2173 | newenv))) |
| 2085 | (macroexpand-all `(letrec ,(nreverse binds) ,@body) | 2174 | ;; Don't override lexical-let's macro-expander. |
| 2086 | ;; Don't override lexical-let's macro-expander. | 2175 | (unless (assq 'function newenv) |
| 2087 | (if (assq 'function newenv) newenv | 2176 | (push (cons 'function #'cl--labels-convert) newenv)) |
| 2088 | (cons (cons 'function #'cl--labels-convert) newenv))))) | 2177 | ;; Perform self-tail call elimination. |
| 2178 | (setq binds (mapcar | ||
| 2179 | (lambda (bind) | ||
| 2180 | (pcase-let* | ||
| 2181 | ((`(,var ,sargs . ,sbody) bind) | ||
| 2182 | (`(function (lambda ,fargs . ,ebody)) | ||
| 2183 | (macroexpand-all `(cl-function (lambda ,sargs . ,sbody)) | ||
| 2184 | newenv)) | ||
| 2185 | (`(,ofargs . ,obody) | ||
| 2186 | (cl--self-tco var fargs ebody))) | ||
| 2187 | `(,var (function (lambda ,ofargs . ,obody))))) | ||
| 2188 | (nreverse binds))) | ||
| 2189 | `(letrec ,binds | ||
| 2190 | . ,(macroexp-unprogn | ||
| 2191 | (macroexpand-all | ||
| 2192 | (macroexp-progn body) | ||
| 2193 | newenv))))) | ||
| 2089 | 2194 | ||
| 2090 | ;; The following ought to have a better definition for use with newer | 2195 | ;; The following ought to have a better definition for use with newer |
| 2091 | ;; byte compilers. | 2196 | ;; byte compilers. |
| @@ -3383,8 +3488,8 @@ macro that returns its `&whole' argument." | |||
| 3383 | (put y 'side-effect-free t)) | 3488 | (put y 'side-effect-free t)) |
| 3384 | 3489 | ||
| 3385 | ;;; Things that are inline. | 3490 | ;;; Things that are inline. |
| 3386 | (cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany | 3491 | (cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend |
| 3387 | cl-notevery cl-revappend cl-nreconc gethash)) | 3492 | cl-nreconc gethash)) |
| 3388 | 3493 | ||
| 3389 | ;;; Things that are side-effect-free. | 3494 | ;;; Things that are side-effect-free. |
| 3390 | (mapc (lambda (x) (function-put x 'side-effect-free t)) | 3495 | (mapc (lambda (x) (function-put x 'side-effect-free t)) |
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 3e5e9b95235..a8361c0d4b4 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el | |||
| @@ -215,7 +215,8 @@ It creates an autoload function for CNAME's constructor." | |||
| 215 | ;; turn this into a usable self-pointing symbol | 215 | ;; turn this into a usable self-pointing symbol |
| 216 | (when eieio-backward-compatibility | 216 | (when eieio-backward-compatibility |
| 217 | (set cname cname) | 217 | (set cname cname) |
| 218 | (make-obsolete-variable cname (format "use \\='%s instead" cname) | 218 | (make-obsolete-variable cname (format "\ |
| 219 | use \\='%s or turn off `eieio-backward-compatibility' instead" cname) | ||
| 219 | "25.1")) | 220 | "25.1")) |
| 220 | 221 | ||
| 221 | (setf (cl--find-class cname) newc) | 222 | (setf (cl--find-class cname) newc) |
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 82a8cd2d777..37844977f8f 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el | |||
| @@ -480,6 +480,35 @@ itself or not." | |||
| 480 | v | 480 | v |
| 481 | (list 'quote v))) | 481 | (list 'quote v))) |
| 482 | 482 | ||
| 483 | (defun macroexp--fgrep (bindings sexp) | ||
| 484 | "Return those of the BINDINGS which might be used in SEXP. | ||
| 485 | It is used as a poor-man's \"free variables\" test. It differs from a true | ||
| 486 | test of free variables in the following ways: | ||
| 487 | - It does not distinguish variables from functions, so it can be used | ||
| 488 | both to detect whether a given variable is used by SEXP and to | ||
| 489 | detect whether a given function is used by SEXP. | ||
| 490 | - It does not actually know ELisp syntax, so it only looks for the presence | ||
| 491 | of symbols in SEXP and can't distinguish if those symbols are truly | ||
| 492 | references to the given variable (or function). That can make the result | ||
| 493 | include bindings which actually aren't used. | ||
| 494 | - For the same reason it may cause the result to fail to include bindings | ||
| 495 | which will be used if SEXP is not yet fully macro-expanded and the | ||
| 496 | use of the binding will only be revealed by macro expansion." | ||
| 497 | (let ((res '())) | ||
| 498 | (while (and (consp sexp) bindings) | ||
| 499 | (dolist (binding (macroexp--fgrep bindings (pop sexp))) | ||
| 500 | (push binding res) | ||
| 501 | (setq bindings (remove binding bindings)))) | ||
| 502 | (if (or (vectorp sexp) (byte-code-function-p sexp)) | ||
| 503 | ;; With backquote, code can appear within vectors as well. | ||
| 504 | ;; This wouldn't be needed if we `macroexpand-all' before | ||
| 505 | ;; calling macroexp--fgrep, OTOH. | ||
| 506 | (macroexp--fgrep bindings (mapcar #'identity sexp)) | ||
| 507 | (let ((tmp (assq sexp bindings))) | ||
| 508 | (if tmp | ||
| 509 | (cons tmp res) | ||
| 510 | res))))) | ||
| 511 | |||
| 483 | ;;; Load-time macro-expansion. | 512 | ;;; Load-time macro-expansion. |
| 484 | 513 | ||
| 485 | ;; Because macro-expansion used to be more lazy, eager macro-expansion | 514 | ;; Because macro-expansion used to be more lazy, eager macro-expansion |
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 40ba1355513..453e86c7831 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -173,12 +173,12 @@ with \"-q\"). | |||
| 173 | 173 | ||
| 174 | Even if the value is nil, you can type \\[package-initialize] to | 174 | Even if the value is nil, you can type \\[package-initialize] to |
| 175 | make installed packages available at any time, or you can | 175 | make installed packages available at any time, or you can |
| 176 | call (package-initialize) in your init-file." | 176 | call (package-activate-all) in your init-file." |
| 177 | :type 'boolean | 177 | :type 'boolean |
| 178 | :version "24.1") | 178 | :version "24.1") |
| 179 | 179 | ||
| 180 | (defcustom package-load-list '(all) | 180 | (defcustom package-load-list '(all) |
| 181 | "List of packages for `package-initialize' to make available. | 181 | "List of packages for `package-activate-all' to make available. |
| 182 | Each element in this list should be a list (NAME VERSION), or the | 182 | Each element in this list should be a list (NAME VERSION), or the |
| 183 | symbol `all'. The symbol `all' says to make available the latest | 183 | symbol `all'. The symbol `all' says to make available the latest |
| 184 | installed versions of all packages not specified by other | 184 | installed versions of all packages not specified by other |
| @@ -292,15 +292,18 @@ the package will be unavailable." | |||
| 292 | :risky t | 292 | :risky t |
| 293 | :version "24.4") | 293 | :version "24.4") |
| 294 | 294 | ||
| 295 | ;;;###autoload | ||
| 295 | (defcustom package-user-dir (locate-user-emacs-file "elpa") | 296 | (defcustom package-user-dir (locate-user-emacs-file "elpa") |
| 296 | "Directory containing the user's Emacs Lisp packages. | 297 | "Directory containing the user's Emacs Lisp packages. |
| 297 | The directory name should be absolute. | 298 | The directory name should be absolute. |
| 298 | Apart from this directory, Emacs also looks for system-wide | 299 | Apart from this directory, Emacs also looks for system-wide |
| 299 | packages in `package-directory-list'." | 300 | packages in `package-directory-list'." |
| 300 | :type 'directory | 301 | :type 'directory |
| 302 | :initialize #'custom-initialize-delay | ||
| 301 | :risky t | 303 | :risky t |
| 302 | :version "24.1") | 304 | :version "24.1") |
| 303 | 305 | ||
| 306 | ;;;###autoload | ||
| 304 | (defcustom package-directory-list | 307 | (defcustom package-directory-list |
| 305 | ;; Defaults are subdirs named "elpa" in the site-lisp dirs. | 308 | ;; Defaults are subdirs named "elpa" in the site-lisp dirs. |
| 306 | (let (result) | 309 | (let (result) |
| @@ -315,6 +318,7 @@ Each directory name should be absolute. | |||
| 315 | These directories contain packages intended for system-wide; in | 318 | These directories contain packages intended for system-wide; in |
| 316 | contrast, `package-user-dir' contains packages for personal use." | 319 | contrast, `package-user-dir' contains packages for personal use." |
| 317 | :type '(repeat directory) | 320 | :type '(repeat directory) |
| 321 | :initialize #'custom-initialize-delay | ||
| 318 | :risky t | 322 | :risky t |
| 319 | :version "24.1") | 323 | :version "24.1") |
| 320 | 324 | ||
| @@ -587,9 +591,8 @@ package." | |||
| 587 | ;;; Installed packages | 591 | ;;; Installed packages |
| 588 | ;; The following variables store information about packages present in | 592 | ;; The following variables store information about packages present in |
| 589 | ;; the system. The most important of these is `package-alist'. The | 593 | ;; the system. The most important of these is `package-alist'. The |
| 590 | ;; command `package-initialize' is also closely related to this | 594 | ;; command `package-activate-all' is also closely related to this |
| 591 | ;; section, but it is left for a later section because it also affects | 595 | ;; section. |
| 592 | ;; other stuff. | ||
| 593 | 596 | ||
| 594 | (defvar package--builtins nil | 597 | (defvar package--builtins nil |
| 595 | "Alist of built-in packages. | 598 | "Alist of built-in packages. |
| @@ -608,7 +611,7 @@ name (a symbol) and DESCS is a non-empty list of `package-desc' | |||
| 608 | structures, sorted by decreasing versions. | 611 | structures, sorted by decreasing versions. |
| 609 | 612 | ||
| 610 | This variable is set automatically by `package-load-descriptor', | 613 | This variable is set automatically by `package-load-descriptor', |
| 611 | called via `package-initialize'. To change which packages are | 614 | called via `package-activate-all'. To change which packages are |
| 612 | loaded and/or activated, customize `package-load-list'.") | 615 | loaded and/or activated, customize `package-load-list'.") |
| 613 | (put 'package-alist 'risky-local-variable t) | 616 | (put 'package-alist 'risky-local-variable t) |
| 614 | 617 | ||
| @@ -869,6 +872,20 @@ DIR, sorted by most recently loaded last." | |||
| 869 | (lambda (x y) (< (cdr x) (cdr y)))))))) | 872 | (lambda (x y) (< (cdr x) (cdr y)))))))) |
| 870 | 873 | ||
| 871 | ;;;; `package-activate' | 874 | ;;;; `package-activate' |
| 875 | |||
| 876 | (defun package--get-activatable-pkg (pkg-name) | ||
| 877 | ;; Is "activatable" a word? | ||
| 878 | (let ((pkg-descs (cdr (assq pkg-name package-alist)))) | ||
| 879 | ;; Check if PACKAGE is available in `package-alist'. | ||
| 880 | (while | ||
| 881 | (when pkg-descs | ||
| 882 | (let ((available-version (package-desc-version (car pkg-descs)))) | ||
| 883 | (or (package-disabled-p pkg-name available-version) | ||
| 884 | ;; Prefer a builtin package. | ||
| 885 | (package-built-in-p pkg-name available-version)))) | ||
| 886 | (setq pkg-descs (cdr pkg-descs))) | ||
| 887 | (car pkg-descs))) | ||
| 888 | |||
| 872 | ;; This function activates a newer version of a package if an older | 889 | ;; This function activates a newer version of a package if an older |
| 873 | ;; one was already activated. It also loads a features of this | 890 | ;; one was already activated. It also loads a features of this |
| 874 | ;; package which were already loaded. | 891 | ;; package which were already loaded. |
| @@ -876,24 +893,16 @@ DIR, sorted by most recently loaded last." | |||
| 876 | "Activate the package named PACKAGE. | 893 | "Activate the package named PACKAGE. |
| 877 | If FORCE is true, (re-)activate it if it's already activated. | 894 | If FORCE is true, (re-)activate it if it's already activated. |
| 878 | Newer versions are always activated, regardless of FORCE." | 895 | Newer versions are always activated, regardless of FORCE." |
| 879 | (let ((pkg-descs (cdr (assq package package-alist)))) | 896 | (let ((pkg-desc (package--get-activatable-pkg package))) |
| 880 | ;; Check if PACKAGE is available in `package-alist'. | ||
| 881 | (while | ||
| 882 | (when pkg-descs | ||
| 883 | (let ((available-version (package-desc-version (car pkg-descs)))) | ||
| 884 | (or (package-disabled-p package available-version) | ||
| 885 | ;; Prefer a builtin package. | ||
| 886 | (package-built-in-p package available-version)))) | ||
| 887 | (setq pkg-descs (cdr pkg-descs))) | ||
| 888 | (cond | 897 | (cond |
| 889 | ;; If no such package is found, maybe it's built-in. | 898 | ;; If no such package is found, maybe it's built-in. |
| 890 | ((null pkg-descs) | 899 | ((null pkg-desc) |
| 891 | (package-built-in-p package)) | 900 | (package-built-in-p package)) |
| 892 | ;; If the package is already activated, just return t. | 901 | ;; If the package is already activated, just return t. |
| 893 | ((and (memq package package-activated-list) (not force)) | 902 | ((and (memq package package-activated-list) (not force)) |
| 894 | t) | 903 | t) |
| 895 | ;; Otherwise, proceed with activation. | 904 | ;; Otherwise, proceed with activation. |
| 896 | (t (package-activate-1 (car pkg-descs) nil 'deps))))) | 905 | (t (package-activate-1 pkg-desc nil 'deps))))) |
| 897 | 906 | ||
| 898 | 907 | ||
| 899 | ;;; Installation -- Local operations | 908 | ;;; Installation -- Local operations |
| @@ -1616,9 +1625,8 @@ that code in the early init-file." | |||
| 1616 | ;; `package--initialized' is t. | 1625 | ;; `package--initialized' is t. |
| 1617 | (package--build-compatibility-table)) | 1626 | (package--build-compatibility-table)) |
| 1618 | 1627 | ||
| 1619 | (defvar package-quickstart-file) | ||
| 1620 | |||
| 1621 | ;;;###autoload | 1628 | ;;;###autoload |
| 1629 | (progn ;; Make the function usable without loading `package.el'. | ||
| 1622 | (defun package-activate-all () | 1630 | (defun package-activate-all () |
| 1623 | "Activate all installed packages. | 1631 | "Activate all installed packages. |
| 1624 | The variable `package-load-list' controls which packages to load." | 1632 | The variable `package-load-list' controls which packages to load." |
| @@ -1632,13 +1640,19 @@ The variable `package-load-list' controls which packages to load." | |||
| 1632 | ;; 2 when loading the .el file (this assumes we were careful to | 1640 | ;; 2 when loading the .el file (this assumes we were careful to |
| 1633 | ;; save this file so it doesn't need any decoding). | 1641 | ;; save this file so it doesn't need any decoding). |
| 1634 | (let ((load-source-file-function nil)) | 1642 | (let ((load-source-file-function nil)) |
| 1643 | (unless (boundp 'package-activated-list) | ||
| 1644 | (setq package-activated-list nil)) | ||
| 1635 | (load qs nil 'nomessage)) | 1645 | (load qs nil 'nomessage)) |
| 1636 | (dolist (elt (package--alist)) | 1646 | (require 'package) |
| 1637 | (condition-case err | 1647 | (package--activate-all))))) |
| 1638 | (package-activate (car elt)) | 1648 | |
| 1639 | ;; Don't let failure of activation of a package arbitrarily stop | 1649 | (defun package--activate-all () |
| 1640 | ;; activation of further packages. | 1650 | (dolist (elt (package--alist)) |
| 1641 | (error (message "%s" (error-message-string err)))))))) | 1651 | (condition-case err |
| 1652 | (package-activate (car elt)) | ||
| 1653 | ;; Don't let failure of activation of a package arbitrarily stop | ||
| 1654 | ;; activation of further packages. | ||
| 1655 | (error (message "%s" (error-message-string err)))))) | ||
| 1642 | 1656 | ||
| 1643 | ;;;; Populating `package-archive-contents' from archives | 1657 | ;;;; Populating `package-archive-contents' from archives |
| 1644 | ;; This subsection populates the variables listed above from the | 1658 | ;; This subsection populates the variables listed above from the |
| @@ -2066,6 +2080,13 @@ PACKAGES are satisfied, i.e. that PACKAGES is computed | |||
| 2066 | using `package-compute-transaction'." | 2080 | using `package-compute-transaction'." |
| 2067 | (mapc #'package-install-from-archive packages)) | 2081 | (mapc #'package-install-from-archive packages)) |
| 2068 | 2082 | ||
| 2083 | (defun package--archives-initialize () | ||
| 2084 | "Make sure the list of installed and remote packages are initialized." | ||
| 2085 | (unless package--initialized | ||
| 2086 | (package-initialize t)) | ||
| 2087 | (unless package-archive-contents | ||
| 2088 | (package-refresh-contents))) | ||
| 2089 | |||
| 2069 | ;;;###autoload | 2090 | ;;;###autoload |
| 2070 | (defun package-install (pkg &optional dont-select) | 2091 | (defun package-install (pkg &optional dont-select) |
| 2071 | "Install the package PKG. | 2092 | "Install the package PKG. |
| @@ -2086,10 +2107,7 @@ to install it but still mark it as selected." | |||
| 2086 | (progn | 2107 | (progn |
| 2087 | ;; Initialize the package system to get the list of package | 2108 | ;; Initialize the package system to get the list of package |
| 2088 | ;; symbols for completion. | 2109 | ;; symbols for completion. |
| 2089 | (unless package--initialized | 2110 | (package--archives-initialize) |
| 2090 | (package-initialize t)) | ||
| 2091 | (unless package-archive-contents | ||
| 2092 | (package-refresh-contents)) | ||
| 2093 | (list (intern (completing-read | 2111 | (list (intern (completing-read |
| 2094 | "Install package: " | 2112 | "Install package: " |
| 2095 | (delq nil | 2113 | (delq nil |
| @@ -2099,6 +2117,7 @@ to install it but still mark it as selected." | |||
| 2099 | package-archive-contents)) | 2117 | package-archive-contents)) |
| 2100 | nil t)) | 2118 | nil t)) |
| 2101 | nil))) | 2119 | nil))) |
| 2120 | (package--archives-initialize) | ||
| 2102 | (add-hook 'post-command-hook #'package-menu--post-refresh) | 2121 | (add-hook 'post-command-hook #'package-menu--post-refresh) |
| 2103 | (let ((name (if (package-desc-p pkg) | 2122 | (let ((name (if (package-desc-p pkg) |
| 2104 | (package-desc-name pkg) | 2123 | (package-desc-name pkg) |
| @@ -3714,7 +3733,7 @@ short description." | |||
| 3714 | (package-menu--generate nil t))) | 3733 | (package-menu--generate nil t))) |
| 3715 | ;; The package menu buffer has keybindings. If the user types | 3734 | ;; The package menu buffer has keybindings. If the user types |
| 3716 | ;; `M-x list-packages', that suggests it should become current. | 3735 | ;; `M-x list-packages', that suggests it should become current. |
| 3717 | (switch-to-buffer buf))) | 3736 | (pop-to-buffer-same-window buf))) |
| 3718 | 3737 | ||
| 3719 | ;;;###autoload | 3738 | ;;;###autoload |
| 3720 | (defalias 'package-list-packages 'list-packages) | 3739 | (defalias 'package-list-packages 'list-packages) |
| @@ -4042,10 +4061,12 @@ activations need to be changed, such as when `package-load-list' is modified." | |||
| 4042 | :type 'boolean | 4061 | :type 'boolean |
| 4043 | :version "27.1") | 4062 | :version "27.1") |
| 4044 | 4063 | ||
| 4064 | ;;;###autoload | ||
| 4045 | (defcustom package-quickstart-file | 4065 | (defcustom package-quickstart-file |
| 4046 | (locate-user-emacs-file "package-quickstart.el") | 4066 | (locate-user-emacs-file "package-quickstart.el") |
| 4047 | "Location of the file used to speed up activation of packages at startup." | 4067 | "Location of the file used to speed up activation of packages at startup." |
| 4048 | :type 'file | 4068 | :type 'file |
| 4069 | :initialize #'custom-initialize-delay | ||
| 4049 | :version "27.1") | 4070 | :version "27.1") |
| 4050 | 4071 | ||
| 4051 | (defun package--quickstart-maybe-refresh () | 4072 | (defun package--quickstart-maybe-refresh () |
| @@ -4111,6 +4132,8 @@ activations need to be changed, such as when `package-load-list' is modified." | |||
| 4111 | ;; no-update-autoloads: t | 4132 | ;; no-update-autoloads: t |
| 4112 | ;; End: | 4133 | ;; End: |
| 4113 | ")) | 4134 | ")) |
| 4135 | ;; FIXME: Do it asynchronously in an Emacs subprocess, and | ||
| 4136 | ;; don't show the byte-compiler warnings. | ||
| 4114 | (byte-compile-file package-quickstart-file))) | 4137 | (byte-compile-file package-quickstart-file))) |
| 4115 | 4138 | ||
| 4116 | (defun package--imenu-prev-index-position-function () | 4139 | (defun package--imenu-prev-index-position-function () |
| @@ -4131,6 +4154,15 @@ beginning of the line." | |||
| 4131 | (package-version-join (package-desc-version package-desc)) | 4154 | (package-version-join (package-desc-version package-desc)) |
| 4132 | (package-desc-summary package-desc)))) | 4155 | (package-desc-summary package-desc)))) |
| 4133 | 4156 | ||
| 4157 | ;;;; Introspection | ||
| 4158 | |||
| 4159 | (defun package-get-descriptor (pkg-name) | ||
| 4160 | "Return the `package-desc' of PKG-NAME." | ||
| 4161 | (unless package--initialized (package-initialize 'no-activate)) | ||
| 4162 | (or (package--get-activatable-pkg pkg-name) | ||
| 4163 | (cadr (assq pkg-name package-alist)) | ||
| 4164 | (cadr (assq pkg-name package-archive-contents)))) | ||
| 4165 | |||
| 4134 | (provide 'package) | 4166 | (provide 'package) |
| 4135 | 4167 | ||
| 4136 | ;;; package.el ends here | 4168 | ;;; package.el ends here |
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 8fb79d220de..72ea1ba0188 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el | |||
| @@ -344,7 +344,7 @@ of the elements of LIST is performed as if by `pcase-let'. | |||
| 344 | (seen '()) | 344 | (seen '()) |
| 345 | (codegen | 345 | (codegen |
| 346 | (lambda (code vars) | 346 | (lambda (code vars) |
| 347 | (let ((vars (pcase--fgrep vars code)) | 347 | (let ((vars (macroexp--fgrep vars code)) |
| 348 | (prev (assq code seen))) | 348 | (prev (assq code seen))) |
| 349 | (if (not prev) | 349 | (if (not prev) |
| 350 | (let ((res (pcase-codegen code vars))) | 350 | (let ((res (pcase-codegen code vars))) |
| @@ -401,7 +401,7 @@ of the elements of LIST is performed as if by `pcase-let'. | |||
| 401 | ;; occurrences of this leaf since it's small. | 401 | ;; occurrences of this leaf since it's small. |
| 402 | (lambda (code vars) | 402 | (lambda (code vars) |
| 403 | (pcase-codegen code | 403 | (pcase-codegen code |
| 404 | (pcase--fgrep vars code))) | 404 | (macroexp--fgrep vars code))) |
| 405 | codegen) | 405 | codegen) |
| 406 | (cdr case) | 406 | (cdr case) |
| 407 | vars)))) | 407 | vars)))) |
| @@ -668,7 +668,7 @@ MATCH is the pattern that needs to be matched, of the form: | |||
| 668 | ;; run, but we don't have the environment in which `pat' will | 668 | ;; run, but we don't have the environment in which `pat' will |
| 669 | ;; run, so we can't do a reliable verification. But let's try | 669 | ;; run, so we can't do a reliable verification. But let's try |
| 670 | ;; and catch at least the easy cases such as (bug#14773). | 670 | ;; and catch at least the easy cases such as (bug#14773). |
| 671 | (not (pcase--fgrep (mapcar #'car vars) (cadr upat))))) | 671 | (not (macroexp--fgrep (mapcar #'car vars) (cadr upat))))) |
| 672 | '(:pcase--succeed . :pcase--fail)) | 672 | '(:pcase--succeed . :pcase--fail)) |
| 673 | ((and (eq 'pred (car upat)) | 673 | ((and (eq 'pred (car upat)) |
| 674 | (let ((otherpred | 674 | (let ((otherpred |
| @@ -692,23 +692,6 @@ MATCH is the pattern that needs to be matched, of the form: | |||
| 692 | '(nil . :pcase--fail) | 692 | '(nil . :pcase--fail) |
| 693 | '(:pcase--fail . nil)))))) | 693 | '(:pcase--fail . nil)))))) |
| 694 | 694 | ||
| 695 | (defun pcase--fgrep (bindings sexp) | ||
| 696 | "Return those of the BINDINGS which might be used in SEXP." | ||
| 697 | (let ((res '())) | ||
| 698 | (while (and (consp sexp) bindings) | ||
| 699 | (dolist (binding (pcase--fgrep bindings (pop sexp))) | ||
| 700 | (push binding res) | ||
| 701 | (setq bindings (remove binding bindings)))) | ||
| 702 | (if (vectorp sexp) | ||
| 703 | ;; With backquote, code can appear within vectors as well. | ||
| 704 | ;; This wouldn't be needed if we `macroexpand-all' before | ||
| 705 | ;; calling pcase--fgrep, OTOH. | ||
| 706 | (pcase--fgrep bindings (mapcar #'identity sexp)) | ||
| 707 | (let ((tmp (assq sexp bindings))) | ||
| 708 | (if tmp | ||
| 709 | (cons tmp res) | ||
| 710 | res))))) | ||
| 711 | |||
| 712 | (defun pcase--self-quoting-p (upat) | 695 | (defun pcase--self-quoting-p (upat) |
| 713 | (or (keywordp upat) (integerp upat) (stringp upat))) | 696 | (or (keywordp upat) (integerp upat) (stringp upat))) |
| 714 | 697 | ||
| @@ -749,7 +732,7 @@ MATCH is the pattern that needs to be matched, of the form: | |||
| 749 | `(,fun ,arg) | 732 | `(,fun ,arg) |
| 750 | (let* (;; `env' is an upper bound on the bindings we need. | 733 | (let* (;; `env' is an upper bound on the bindings we need. |
| 751 | (env (mapcar (lambda (x) (list (car x) (cdr x))) | 734 | (env (mapcar (lambda (x) (list (car x) (cdr x))) |
| 752 | (pcase--fgrep vars fun))) | 735 | (macroexp--fgrep vars fun))) |
| 753 | (call (progn | 736 | (call (progn |
| 754 | (when (assq arg env) | 737 | (when (assq arg env) |
| 755 | ;; `arg' is shadowed by `env'. | 738 | ;; `arg' is shadowed by `env'. |
| @@ -770,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form: | |||
| 770 | "Build an expression that will evaluate EXP." | 753 | "Build an expression that will evaluate EXP." |
| 771 | (let* ((found (assq exp vars))) | 754 | (let* ((found (assq exp vars))) |
| 772 | (if found (cdr found) | 755 | (if found (cdr found) |
| 773 | (let* ((env (pcase--fgrep vars exp))) | 756 | (let* ((env (macroexp--fgrep vars exp))) |
| 774 | (if env | 757 | (if env |
| 775 | (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) | 758 | (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) |
| 776 | env) | 759 | env) |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 1044acff8d5..bb68173b6dc 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -1046,8 +1046,8 @@ anyway." | |||
| 1046 | (make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") | 1046 | (make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") |
| 1047 | 1047 | ||
| 1048 | (defcustom erc-pre-send-functions nil | 1048 | (defcustom erc-pre-send-functions nil |
| 1049 | "List of functions called to possibly alter the string that is sent. | 1049 | "Special hook run to possibly alter the string that is sent. |
| 1050 | The functions are called with one argument, a `erc-input' struct, | 1050 | The functions are called with one argument, an `erc-input' struct, |
| 1051 | and should alter that struct. | 1051 | and should alter that struct. |
| 1052 | 1052 | ||
| 1053 | The struct has three slots: | 1053 | The struct has three slots: |
| @@ -1056,7 +1056,7 @@ The struct has three slots: | |||
| 1056 | `insertp': Whether the string should be inserted into the erc buffer. | 1056 | `insertp': Whether the string should be inserted into the erc buffer. |
| 1057 | `sendp': Whether the string should be sent to the irc server." | 1057 | `sendp': Whether the string should be sent to the irc server." |
| 1058 | :group 'erc | 1058 | :group 'erc |
| 1059 | :type '(repeat function) | 1059 | :type 'hook |
| 1060 | :version "27.1") | 1060 | :version "27.1") |
| 1061 | 1061 | ||
| 1062 | (defvar erc-insert-this t | 1062 | (defvar erc-insert-this t |
| @@ -1295,9 +1295,9 @@ Example: | |||
| 1295 | (define-erc-module replace nil | 1295 | (define-erc-module replace nil |
| 1296 | \"This mode replaces incoming text according to `erc-replace-alist'.\" | 1296 | \"This mode replaces incoming text according to `erc-replace-alist'.\" |
| 1297 | ((add-hook \\='erc-insert-modify-hook | 1297 | ((add-hook \\='erc-insert-modify-hook |
| 1298 | \\='erc-replace-insert)) | 1298 | #\\='erc-replace-insert)) |
| 1299 | ((remove-hook \\='erc-insert-modify-hook | 1299 | ((remove-hook \\='erc-insert-modify-hook |
| 1300 | \\='erc-replace-insert)))" | 1300 | #\\='erc-replace-insert)))" |
| 1301 | (declare (doc-string 3)) | 1301 | (declare (doc-string 3)) |
| 1302 | (let* ((sn (symbol-name name)) | 1302 | (let* ((sn (symbol-name name)) |
| 1303 | (mode (intern (format "erc-%s-mode" (downcase sn)))) | 1303 | (mode (intern (format "erc-%s-mode" (downcase sn)))) |
| @@ -1495,7 +1495,7 @@ Defaults to the server buffer." | |||
| 1495 | (setq-local paragraph-start | 1495 | (setq-local paragraph-start |
| 1496 | (concat "\\(" (regexp-quote (erc-prompt)) "\\)")) | 1496 | (concat "\\(" (regexp-quote (erc-prompt)) "\\)")) |
| 1497 | (setq-local completion-ignore-case t) | 1497 | (setq-local completion-ignore-case t) |
| 1498 | (add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t)) | 1498 | (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t)) |
| 1499 | 1499 | ||
| 1500 | ;; activation | 1500 | ;; activation |
| 1501 | 1501 | ||
| @@ -2585,7 +2585,7 @@ This function adds `erc-lurker-update-status' to | |||
| 2585 | most recent PRIVMSG as well as initializing the state variable | 2585 | most recent PRIVMSG as well as initializing the state variable |
| 2586 | storing this information." | 2586 | storing this information." |
| 2587 | (setq erc-lurker-state (make-hash-table :test 'equal)) | 2587 | (setq erc-lurker-state (make-hash-table :test 'equal)) |
| 2588 | (add-hook 'erc-insert-pre-hook 'erc-lurker-update-status)) | 2588 | (add-hook 'erc-insert-pre-hook #'erc-lurker-update-status)) |
| 2589 | 2589 | ||
| 2590 | (defun erc-lurker-cleanup () | 2590 | (defun erc-lurker-cleanup () |
| 2591 | "Remove all last PRIVMSG state older than `erc-lurker-threshold-time'. | 2591 | "Remove all last PRIVMSG state older than `erc-lurker-threshold-time'. |
| @@ -2694,7 +2694,7 @@ otherwise `erc-server-announced-name'. SERVER is matched against | |||
| 2694 | (defun erc-add-targets (scope target-list) | 2694 | (defun erc-add-targets (scope target-list) |
| 2695 | (let ((targets | 2695 | (let ((targets |
| 2696 | (mapcar (lambda (targets) (member scope targets)) target-list))) | 2696 | (mapcar (lambda (targets) (member scope targets)) target-list))) |
| 2697 | (cdr (apply 'append (delete nil targets))))) | 2697 | (cdr (apply #'append (delete nil targets))))) |
| 2698 | 2698 | ||
| 2699 | (defun erc-hide-current-message-p (parsed) | 2699 | (defun erc-hide-current-message-p (parsed) |
| 2700 | "Predicate indicating whether the parsed ERC response PARSED should be hidden. | 2700 | "Predicate indicating whether the parsed ERC response PARSED should be hidden. |
| @@ -3038,7 +3038,7 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." | |||
| 3038 | (erc-display-message | 3038 | (erc-display-message |
| 3039 | nil 'notice (current-buffer) 'ops | 3039 | nil 'notice (current-buffer) 'ops |
| 3040 | ?i (length ops) ?s (if (> (length ops) 1) "s" "") | 3040 | ?i (length ops) ?s (if (> (length ops) 1) "s" "") |
| 3041 | ?o (mapconcat 'identity ops " ")) | 3041 | ?o (mapconcat #'identity ops " ")) |
| 3042 | (erc-display-message nil 'notice (current-buffer) 'ops-none))) | 3042 | (erc-display-message nil 'notice (current-buffer) 'ops-none))) |
| 3043 | t) | 3043 | t) |
| 3044 | 3044 | ||
| @@ -3209,7 +3209,7 @@ command." | |||
| 3209 | (defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords) | 3209 | (defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords) |
| 3210 | "Kick the user indicated in LINE from the current channel. | 3210 | "Kick the user indicated in LINE from the current channel. |
| 3211 | LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"." | 3211 | LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"." |
| 3212 | (let ((reasonstring (mapconcat 'identity reasonwords " "))) | 3212 | (let ((reasonstring (mapconcat #'identity reasonwords " "))) |
| 3213 | (if (string= "" reasonstring) | 3213 | (if (string= "" reasonstring) |
| 3214 | (setq reasonstring (format "Kicked by %s" (erc-current-nick)))) | 3214 | (setq reasonstring (format "Kicked by %s" (erc-current-nick)))) |
| 3215 | (if (erc-channel-p target) | 3215 | (if (erc-channel-p target) |
| @@ -3744,7 +3744,7 @@ the message given by REASON." | |||
| 3744 | " -" | 3744 | " -" |
| 3745 | (make-string (length people) ?o) | 3745 | (make-string (length people) ?o) |
| 3746 | " " | 3746 | " " |
| 3747 | (mapconcat 'identity people " "))) | 3747 | (mapconcat #'identity people " "))) |
| 3748 | t)) | 3748 | t)) |
| 3749 | 3749 | ||
| 3750 | (defun erc-cmd-OP (&rest people) | 3750 | (defun erc-cmd-OP (&rest people) |
| @@ -3754,7 +3754,7 @@ the message given by REASON." | |||
| 3754 | " +" | 3754 | " +" |
| 3755 | (make-string (length people) ?o) | 3755 | (make-string (length people) ?o) |
| 3756 | " " | 3756 | " " |
| 3757 | (mapconcat 'identity people " "))) | 3757 | (mapconcat #'identity people " "))) |
| 3758 | t)) | 3758 | t)) |
| 3759 | 3759 | ||
| 3760 | (defun erc-cmd-TIME (&optional line) | 3760 | (defun erc-cmd-TIME (&optional line) |
| @@ -3952,7 +3952,7 @@ Unban all currently banned users in the current channel." | |||
| 3952 | (erc-server-send | 3952 | (erc-server-send |
| 3953 | (format "MODE %s -%s %s" (erc-default-target) | 3953 | (format "MODE %s -%s %s" (erc-default-target) |
| 3954 | (make-string (length x) ?b) | 3954 | (make-string (length x) ?b) |
| 3955 | (mapconcat 'identity x " ")))) | 3955 | (mapconcat #'identity x " ")))) |
| 3956 | (erc-group-list bans 3)))) | 3956 | (erc-group-list bans 3)))) |
| 3957 | t)))) | 3957 | t)))) |
| 3958 | 3958 | ||
| @@ -4183,7 +4183,7 @@ Displays PROC and PARSED appropriately using `erc-display-message'." | |||
| 4183 | (erc-display-message | 4183 | (erc-display-message |
| 4184 | parsed 'notice proc | 4184 | parsed 'notice proc |
| 4185 | (mapconcat | 4185 | (mapconcat |
| 4186 | 'identity | 4186 | #'identity |
| 4187 | (let (res) | 4187 | (let (res) |
| 4188 | (mapc #'(lambda (x) | 4188 | (mapc #'(lambda (x) |
| 4189 | (if (stringp x) | 4189 | (if (stringp x) |
| @@ -5553,12 +5553,10 @@ This returns non-nil only if we actually send anything." | |||
| 5553 | ;; Instead `erc-pre-send-functions' is used as a filter to do | 5553 | ;; Instead `erc-pre-send-functions' is used as a filter to do |
| 5554 | ;; allow both changing and suppressing the string. | 5554 | ;; allow both changing and suppressing the string. |
| 5555 | (run-hook-with-args 'erc-send-pre-hook input) | 5555 | (run-hook-with-args 'erc-send-pre-hook input) |
| 5556 | (setq state (make-erc-input :string str | 5556 | (setq state (make-erc-input :string str ;May be != from `input' now! |
| 5557 | :insertp erc-insert-this | 5557 | :insertp erc-insert-this |
| 5558 | :sendp erc-send-this)) | 5558 | :sendp erc-send-this)) |
| 5559 | (dolist (func erc-pre-send-functions) | 5559 | (run-hook-with-args 'erc-pre-send-functions state) |
| 5560 | ;; The functions can return nil to inhibit sending. | ||
| 5561 | (funcall func state)) | ||
| 5562 | (when (and (erc-input-sendp state) | 5560 | (when (and (erc-input-sendp state) |
| 5563 | erc-send-this) | 5561 | erc-send-this) |
| 5564 | (let ((string (erc-input-string state))) | 5562 | (let ((string (erc-input-string state))) |
| @@ -5579,26 +5577,26 @@ This returns non-nil only if we actually send anything." | |||
| 5579 | (erc-process-input-line (concat string "\n") t nil)) | 5577 | (erc-process-input-line (concat string "\n") t nil)) |
| 5580 | t)))))) | 5578 | t)))))) |
| 5581 | 5579 | ||
| 5582 | (defun erc-display-command (line) | 5580 | ;; (defun erc-display-command (line) |
| 5583 | (when erc-insert-this | 5581 | ;; (when erc-insert-this |
| 5584 | (let ((insert-position (point))) | 5582 | ;; (let ((insert-position (point))) |
| 5585 | (unless erc-hide-prompt | 5583 | ;; (unless erc-hide-prompt |
| 5586 | (erc-display-prompt nil nil (erc-command-indicator) | 5584 | ;; (erc-display-prompt nil nil (erc-command-indicator) |
| 5587 | (and (erc-command-indicator) | 5585 | ;; (and (erc-command-indicator) |
| 5588 | 'erc-command-indicator-face))) | 5586 | ;; 'erc-command-indicator-face))) |
| 5589 | (let ((beg (point))) | 5587 | ;; (let ((beg (point))) |
| 5590 | (insert line) | 5588 | ;; (insert line) |
| 5591 | (erc-put-text-property beg (point) | 5589 | ;; (erc-put-text-property beg (point) |
| 5592 | 'font-lock-face 'erc-command-indicator-face) | 5590 | ;; 'font-lock-face 'erc-command-indicator-face) |
| 5593 | (insert "\n")) | 5591 | ;; (insert "\n")) |
| 5594 | (when (processp erc-server-process) | 5592 | ;; (when (processp erc-server-process) |
| 5595 | (set-marker (process-mark erc-server-process) (point))) | 5593 | ;; (set-marker (process-mark erc-server-process) (point))) |
| 5596 | (set-marker erc-insert-marker (point)) | 5594 | ;; (set-marker erc-insert-marker (point)) |
| 5597 | (save-excursion | 5595 | ;; (save-excursion |
| 5598 | (save-restriction | 5596 | ;; (save-restriction |
| 5599 | (narrow-to-region insert-position (point)) | 5597 | ;; (narrow-to-region insert-position (point)) |
| 5600 | (run-hooks 'erc-send-modify-hook) | 5598 | ;; (run-hooks 'erc-send-modify-hook) |
| 5601 | (run-hooks 'erc-send-post-hook)))))) | 5599 | ;; (run-hooks 'erc-send-post-hook)))))) |
| 5602 | 5600 | ||
| 5603 | (defun erc-display-msg (line) | 5601 | (defun erc-display-msg (line) |
| 5604 | "Display LINE as a message of the user to the current target at the | 5602 | "Display LINE as a message of the user to the current target at the |
| @@ -6563,7 +6561,7 @@ If optional argument HERE is non-nil, insert version number at point." | |||
| 6563 | If optional argument HERE is non-nil, insert version number at point." | 6561 | If optional argument HERE is non-nil, insert version number at point." |
| 6564 | (interactive "P") | 6562 | (interactive "P") |
| 6565 | (let ((string | 6563 | (let ((string |
| 6566 | (mapconcat 'identity | 6564 | (mapconcat #'identity |
| 6567 | (let (modes (case-fold-search nil)) | 6565 | (let (modes (case-fold-search nil)) |
| 6568 | (dolist (var (apropos-internal "^erc-.*mode$")) | 6566 | (dolist (var (apropos-internal "^erc-.*mode$")) |
| 6569 | (when (and (boundp var) | 6567 | (when (and (boundp var) |
| @@ -6817,7 +6815,8 @@ See also `format-spec'." | |||
| 6817 | 6815 | ||
| 6818 | ;;; Various hook functions | 6816 | ;;; Various hook functions |
| 6819 | 6817 | ||
| 6820 | (add-hook 'kill-buffer-hook 'erc-kill-buffer-function) | 6818 | ;; FIXME: Don't set the hook globally! |
| 6819 | (add-hook 'kill-buffer-hook #'erc-kill-buffer-function) | ||
| 6821 | 6820 | ||
| 6822 | (defcustom erc-kill-server-hook '(erc-kill-server) | 6821 | (defcustom erc-kill-server-hook '(erc-kill-server) |
| 6823 | "Invoked whenever a server buffer is killed via `kill-buffer'." | 6822 | "Invoked whenever a server buffer is killed via `kill-buffer'." |
diff --git a/lisp/facemenu.el b/lisp/facemenu.el index d362adcc9b7..2609397b0d9 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; facemenu.el --- create a face menu for interactively adding fonts to text | 1 | ;;; facemenu.el --- create a face menu for interactively adding fonts to text -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
diff --git a/lisp/filesets.el b/lisp/filesets.el index 7c01b15b345..2ef13ae8320 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; filesets.el --- handle group of files | 1 | ;;; filesets.el --- handle group of files -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -88,7 +88,8 @@ | |||
| 88 | 88 | ||
| 89 | ;;; Code: | 89 | ;;; Code: |
| 90 | 90 | ||
| 91 | (eval-when-compile (require 'cl-lib)) | 91 | (require 'cl-lib) |
| 92 | (require 'seq) | ||
| 92 | (require 'easymenu) | 93 | (require 'easymenu) |
| 93 | 94 | ||
| 94 | ;;; Some variables | 95 | ;;; Some variables |
| @@ -153,52 +154,25 @@ COND-FN takes one argument: the current element." | |||
| 153 | ; (cl-remove 'dummy lst :test (lambda (dummy elt) | 154 | ; (cl-remove 'dummy lst :test (lambda (dummy elt) |
| 154 | ; (not (funcall cond-fn elt))))) | 155 | ; (not (funcall cond-fn elt))))) |
| 155 | (let ((rv nil)) | 156 | (let ((rv nil)) |
| 156 | (dolist (elt lst rv) | 157 | (dolist (elt lst) |
| 157 | (when (funcall cond-fn elt) | 158 | (when (funcall cond-fn elt) |
| 158 | (setq rv (append rv (list elt))))))) | 159 | (push elt rv))) |
| 160 | (nreverse rv))) | ||
| 159 | 161 | ||
| 160 | (defun filesets-ormap (fsom-pred lst) | 162 | (defun filesets-ormap (fsom-pred lst) |
| 161 | "Return the tail of LST for the head of which FSOM-PRED is non-nil." | 163 | "Return the tail of LST for the head of which FSOM-PRED is non-nil." |
| 162 | (let ((fsom-lst lst) | 164 | (let ((fsom-lst lst) |
| 163 | (fsom-rv nil)) | 165 | (fsom-rv nil)) |
| 164 | (while (and (not (null fsom-lst)) | 166 | (while (and fsom-lst |
| 165 | (null fsom-rv)) | 167 | (null fsom-rv)) |
| 166 | (if (funcall fsom-pred (car fsom-lst)) | 168 | (if (funcall fsom-pred (car fsom-lst)) |
| 167 | (setq fsom-rv fsom-lst) | 169 | (setq fsom-rv fsom-lst) |
| 168 | (setq fsom-lst (cdr fsom-lst)))) | 170 | (setq fsom-lst (cdr fsom-lst)))) |
| 169 | fsom-rv)) | 171 | fsom-rv)) |
| 170 | 172 | ||
| 171 | (defun filesets-some (fss-pred fss-lst) | 173 | (define-obsolete-function-alias 'filesets-some #'cl-some "28.1") |
| 172 | "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST. | 174 | (define-obsolete-function-alias 'filesets-member #'cl-member "28.1") |
| 173 | Like `some', return the first value of FSS-PRED that is non-nil." | 175 | (define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1") |
| 174 | (catch 'exit | ||
| 175 | (dolist (fss-this fss-lst nil) | ||
| 176 | (let ((fss-rv (funcall fss-pred fss-this))) | ||
| 177 | (when fss-rv | ||
| 178 | (throw 'exit fss-rv)))))) | ||
| 179 | ;(fset 'filesets-some 'cl-some) ;; or use the cl function | ||
| 180 | |||
| 181 | (defun filesets-member (fsm-item fsm-lst &rest fsm-keys) | ||
| 182 | "Find the first occurrence of FSM-ITEM in FSM-LST. | ||
| 183 | It is supposed to work like cl's `member*'. At the moment only the :test | ||
| 184 | key is supported." | ||
| 185 | (let ((fsm-test (or (plist-get fsm-keys ':test) | ||
| 186 | (function equal)))) | ||
| 187 | (filesets-ormap (lambda (fsm-this) | ||
| 188 | (funcall fsm-test fsm-item fsm-this)) | ||
| 189 | fsm-lst))) | ||
| 190 | ;(fset 'filesets-member 'cl-member) ;; or use the cl function | ||
| 191 | |||
| 192 | (defun filesets-sublist (lst beg &optional end) | ||
| 193 | "Get the sublist of LST from BEG to END - 1." | ||
| 194 | (let ((rv nil) | ||
| 195 | (i beg) | ||
| 196 | (top (or end | ||
| 197 | (length lst)))) | ||
| 198 | (while (< i top) | ||
| 199 | (setq rv (append rv (list (nth i lst)))) | ||
| 200 | (setq i (+ i 1))) | ||
| 201 | rv)) | ||
| 202 | 176 | ||
| 203 | (defun filesets-select-command (cmd-list) | 177 | (defun filesets-select-command (cmd-list) |
| 204 | "Select one command from CMD-LIST -- a string with space separated names." | 178 | "Select one command from CMD-LIST -- a string with space separated names." |
| @@ -222,7 +196,7 @@ key is supported." | |||
| 222 | (defun filesets-message (level &rest args) | 196 | (defun filesets-message (level &rest args) |
| 223 | "Show a message only if LEVEL is greater or equal then `filesets-verbosity'." | 197 | "Show a message only if LEVEL is greater or equal then `filesets-verbosity'." |
| 224 | (when (<= level (abs filesets-verbosity)) | 198 | (when (<= level (abs filesets-verbosity)) |
| 225 | (apply 'message args))) | 199 | (apply #'message args))) |
| 226 | 200 | ||
| 227 | 201 | ||
| 228 | ;;; config file | 202 | ;;; config file |
| @@ -233,9 +207,9 @@ key is supported." | |||
| 233 | 207 | ||
| 234 | (defun filesets-reset-fileset (&optional fileset no-cache) | 208 | (defun filesets-reset-fileset (&optional fileset no-cache) |
| 235 | "Reset the cached values for one or all filesets." | 209 | "Reset the cached values for one or all filesets." |
| 236 | (if fileset | 210 | (setq filesets-submenus (if fileset |
| 237 | (setq filesets-submenus (lax-plist-put filesets-submenus fileset nil)) | 211 | (lax-plist-put filesets-submenus fileset nil) |
| 238 | (setq filesets-submenus nil)) | 212 | nil)) |
| 239 | (setq filesets-has-changed-flag t) | 213 | (setq filesets-has-changed-flag t) |
| 240 | (setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag | 214 | (setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag |
| 241 | (not no-cache)))) | 215 | (not no-cache)))) |
| @@ -303,50 +277,46 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set with | |||
| 303 | 277 | ||
| 304 | (defcustom filesets-menu-name "Filesets" | 278 | (defcustom filesets-menu-name "Filesets" |
| 305 | "Filesets' menu name." | 279 | "Filesets' menu name." |
| 306 | :set (function filesets-set-default) | 280 | :set #'filesets-set-default |
| 307 | :type 'string | 281 | :type 'string) |
| 308 | :group 'filesets) | ||
| 309 | 282 | ||
| 310 | (defcustom filesets-menu-path '("File") ; cf recentf-menu-path | 283 | (defcustom filesets-menu-path '("File") ; cf recentf-menu-path |
| 311 | "The menu under which the filesets menu should be inserted. | 284 | "The menu under which the filesets menu should be inserted. |
| 312 | See `easy-menu-add-item' for documentation." | 285 | See `easy-menu-add-item' for documentation." |
| 313 | :set (function filesets-set-default) | 286 | :set #'filesets-set-default |
| 314 | :type '(choice (const :tag "Top Level" nil) | 287 | :type '(choice (const :tag "Top Level" nil) |
| 315 | (sexp :tag "Menu Path")) | 288 | (sexp :tag "Menu Path")) |
| 316 | :version "23.1" ; was nil | 289 | :version "23.1" ; was nil |
| 317 | :group 'filesets) | 290 | ) |
| 318 | 291 | ||
| 319 | (defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before | 292 | (defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before |
| 320 | "The name of a menu before which this menu should be added. | 293 | "The name of a menu before which this menu should be added. |
| 321 | See `easy-menu-add-item' for documentation." | 294 | See `easy-menu-add-item' for documentation." |
| 322 | :set (function filesets-set-default) | 295 | :set #'filesets-set-default |
| 323 | :type '(choice (string :tag "Name") | 296 | :type '(choice (string :tag "Name") |
| 324 | (const :tag "Last" nil)) | 297 | (const :tag "Last" nil)) |
| 325 | :version "23.1" ; was "File" | 298 | :version "23.1" ; was "File" |
| 326 | :group 'filesets) | 299 | ) |
| 327 | 300 | ||
| 328 | (defcustom filesets-menu-in-menu nil | 301 | (defcustom filesets-menu-in-menu nil |
| 329 | "Use that instead of `current-menubar' as the menu to change. | 302 | "Use that instead of `current-menubar' as the menu to change. |
| 330 | See `easy-menu-add-item' for documentation." | 303 | See `easy-menu-add-item' for documentation." |
| 331 | :set (function filesets-set-default) | 304 | :set #'filesets-set-default |
| 332 | :type 'sexp | 305 | :type 'sexp) |
| 333 | :group 'filesets) | ||
| 334 | 306 | ||
| 335 | (defcustom filesets-menu-shortcuts-flag t | 307 | (defcustom filesets-menu-shortcuts-flag t |
| 336 | "Non-nil means to prepend menus with hopefully unique shortcuts." | 308 | "Non-nil means to prepend menus with hopefully unique shortcuts." |
| 337 | :set (function filesets-set-default!) | 309 | :set #'filesets-set-default! |
| 338 | :type 'boolean | 310 | :type 'boolean) |
| 339 | :group 'filesets) | ||
| 340 | 311 | ||
| 341 | (defcustom filesets-menu-shortcuts-marker "%_" | 312 | (defcustom filesets-menu-shortcuts-marker "%_" |
| 342 | "String for marking menu shortcuts." | 313 | "String for marking menu shortcuts." |
| 343 | :set (function filesets-set-default!) | 314 | :set #'filesets-set-default! |
| 344 | :type 'string | 315 | :type 'string) |
| 345 | :group 'filesets) | ||
| 346 | 316 | ||
| 347 | ;;(defcustom filesets-menu-cnvfp-flag nil | 317 | ;;(defcustom filesets-menu-cnvfp-flag nil |
| 348 | ;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus." | 318 | ;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus." |
| 349 | ;; :set (function filesets-set-default!) | 319 | ;; :set #'filesets-set-default! |
| 350 | ;; :type 'boolean | 320 | ;; :type 'boolean |
| 351 | ;; :group 'filesets) | 321 | ;; :group 'filesets) |
| 352 | 322 | ||
| @@ -355,9 +325,8 @@ See `easy-menu-add-item' for documentation." | |||
| 355 | "File to be used for saving the filesets menu between sessions. | 325 | "File to be used for saving the filesets menu between sessions. |
| 356 | Set this to \"\", to disable caching of menus. | 326 | Set this to \"\", to disable caching of menus. |
| 357 | Don't forget to check out `filesets-menu-ensure-use-cached'." | 327 | Don't forget to check out `filesets-menu-ensure-use-cached'." |
| 358 | :set (function filesets-set-default) | 328 | :set #'filesets-set-default |
| 359 | :type 'file | 329 | :type 'file) |
| 360 | :group 'filesets) | ||
| 361 | (put 'filesets-menu-cache-file 'risky-local-variable t) | 330 | (put 'filesets-menu-cache-file 'risky-local-variable t) |
| 362 | 331 | ||
| 363 | (defcustom filesets-menu-cache-contents | 332 | (defcustom filesets-menu-cache-contents |
| @@ -383,7 +352,7 @@ If you want caching to work properly, at least `filesets-submenus', | |||
| 383 | list. | 352 | list. |
| 384 | 353 | ||
| 385 | Don't forget to check out `filesets-menu-ensure-use-cached'." | 354 | Don't forget to check out `filesets-menu-ensure-use-cached'." |
| 386 | :set (function filesets-set-default) | 355 | :set #'filesets-set-default |
| 387 | :type '(repeat | 356 | :type '(repeat |
| 388 | (choice :tag "Variable" | 357 | (choice :tag "Variable" |
| 389 | (const :tag "filesets-submenus" | 358 | (const :tag "filesets-submenus" |
| @@ -400,8 +369,7 @@ Don't forget to check out `filesets-menu-ensure-use-cached'." | |||
| 400 | :value filesets-ingroup-patterns) | 369 | :value filesets-ingroup-patterns) |
| 401 | (const :tag "filesets-be-docile-flag" | 370 | (const :tag "filesets-be-docile-flag" |
| 402 | :value filesets-be-docile-flag) | 371 | :value filesets-be-docile-flag) |
| 403 | (sexp :tag "Other" :value nil))) | 372 | (sexp :tag "Other" :value nil)))) |
| 404 | :group 'filesets) | ||
| 405 | 373 | ||
| 406 | (define-obsolete-variable-alias 'filesets-cache-fill-content-hooks | 374 | (define-obsolete-variable-alias 'filesets-cache-fill-content-hooks |
| 407 | 'filesets-cache-fill-content-hook "24.3") | 375 | 'filesets-cache-fill-content-hook "24.3") |
| @@ -423,48 +391,43 @@ configuration file, you can add a something like this | |||
| 423 | to this hook. | 391 | to this hook. |
| 424 | 392 | ||
| 425 | Don't forget to check out `filesets-menu-ensure-use-cached'." | 393 | Don't forget to check out `filesets-menu-ensure-use-cached'." |
| 426 | :set (function filesets-set-default) | 394 | :set #'filesets-set-default |
| 427 | :type 'hook | 395 | :type 'hook) |
| 428 | :group 'filesets) | ||
| 429 | 396 | ||
| 430 | (defcustom filesets-cache-hostname-flag nil | 397 | (defcustom filesets-cache-hostname-flag nil |
| 431 | "Non-nil means cache the hostname. | 398 | "Non-nil means cache the hostname. |
| 432 | If the current name differs from the cached one, | 399 | If the current name differs from the cached one, |
| 433 | rebuild the menu and create a new cache file." | 400 | rebuild the menu and create a new cache file." |
| 434 | :set (function filesets-set-default) | 401 | :set #'filesets-set-default |
| 435 | :type 'boolean | 402 | :type 'boolean) |
| 436 | :group 'filesets) | ||
| 437 | 403 | ||
| 438 | (defcustom filesets-cache-save-often-flag nil | 404 | (defcustom filesets-cache-save-often-flag nil |
| 439 | "Non-nil means save buffer on every change of the filesets menu. | 405 | "Non-nil means save buffer on every change of the filesets menu. |
| 440 | If this variable is set to nil and if Emacs crashes, the cache and | 406 | If this variable is set to nil and if Emacs crashes, the cache and |
| 441 | filesets-data could get out of sync. Set this to t if this happens from | 407 | filesets-data could get out of sync. Set this to t if this happens from |
| 442 | time to time or if the fileset cache causes troubles." | 408 | time to time or if the fileset cache causes troubles." |
| 443 | :set (function filesets-set-default) | 409 | :set #'filesets-set-default |
| 444 | :type 'boolean | 410 | :type 'boolean) |
| 445 | :group 'filesets) | ||
| 446 | 411 | ||
| 447 | (defcustom filesets-max-submenu-length 25 | 412 | (defcustom filesets-max-submenu-length 25 |
| 448 | "Maximum length of submenus. | 413 | "Maximum length of submenus. |
| 449 | Set this value to 0 to turn menu splitting off. BTW, parts of submenus | 414 | Set this value to 0 to turn menu splitting off. BTW, parts of submenus |
| 450 | will not be rewrapped if their length exceeds this value." | 415 | will not be rewrapped if their length exceeds this value." |
| 451 | :set (function filesets-set-default) | 416 | :set #'filesets-set-default |
| 452 | :type 'integer | 417 | :type 'integer) |
| 453 | :group 'filesets) | ||
| 454 | 418 | ||
| 455 | (defcustom filesets-max-entry-length 50 | 419 | (defcustom filesets-max-entry-length 50 |
| 456 | "Truncate names of split submenus to this length." | 420 | "Truncate names of split submenus to this length." |
| 457 | :set (function filesets-set-default) | 421 | :set #'filesets-set-default |
| 458 | :type 'integer | 422 | :type 'integer) |
| 459 | :group 'filesets) | ||
| 460 | 423 | ||
| 461 | (defcustom filesets-browse-dir-function 'dired | 424 | (defcustom filesets-browse-dir-function #'dired |
| 462 | "A function or command used for browsing directories. | 425 | "A function or command used for browsing directories. |
| 463 | When using an external command, \"%s\" will be replaced with the | 426 | When using an external command, \"%s\" will be replaced with the |
| 464 | directory's name. | 427 | directory's name. |
| 465 | 428 | ||
| 466 | Note: You have to manually rebuild the menu if you change this value." | 429 | Note: You have to manually rebuild the menu if you change this value." |
| 467 | :set (function filesets-set-default) | 430 | :set #'filesets-set-default |
| 468 | :type '(choice :tag "Function:" | 431 | :type '(choice :tag "Function:" |
| 469 | (const :tag "dired" | 432 | (const :tag "dired" |
| 470 | :value dired) | 433 | :value dired) |
| @@ -473,10 +436,9 @@ Note: You have to manually rebuild the menu if you change this value." | |||
| 473 | (string :tag "Name") | 436 | (string :tag "Name") |
| 474 | (string :tag "Arguments")) | 437 | (string :tag "Arguments")) |
| 475 | (function :tag "Function" | 438 | (function :tag "Function" |
| 476 | :value nil)) | 439 | :value nil))) |
| 477 | :group 'filesets) | ||
| 478 | 440 | ||
| 479 | (defcustom filesets-open-file-function 'filesets-find-or-display-file | 441 | (defcustom filesets-open-file-function #'filesets-find-or-display-file |
| 480 | "The function used for opening files. | 442 | "The function used for opening files. |
| 481 | 443 | ||
| 482 | `filesets-find-or-display-file' ... Filesets' default function for | 444 | `filesets-find-or-display-file' ... Filesets' default function for |
| @@ -489,26 +451,24 @@ for a specific file type. Either this viewer, if defined, or | |||
| 489 | readable, will not be opened. | 451 | readable, will not be opened. |
| 490 | 452 | ||
| 491 | Caveat: Changes will take effect only after rebuilding the menu." | 453 | Caveat: Changes will take effect only after rebuilding the menu." |
| 492 | :set (function filesets-set-default) | 454 | :set #'filesets-set-default |
| 493 | :type '(choice :tag "Function:" | 455 | :type '(choice :tag "Function:" |
| 494 | (const :tag "filesets-find-or-display-file" | 456 | (const :tag "filesets-find-or-display-file" |
| 495 | :value filesets-find-or-display-file) | 457 | :value filesets-find-or-display-file) |
| 496 | (const :tag "filesets-find-file" | 458 | (const :tag "filesets-find-file" |
| 497 | :value filesets-find-file) | 459 | :value filesets-find-file) |
| 498 | (function :tag "Function" | 460 | (function :tag "Function" |
| 499 | :value nil)) | 461 | :value nil))) |
| 500 | :group 'filesets) | ||
| 501 | 462 | ||
| 502 | (defcustom filesets-save-buffer-function 'save-buffer | 463 | (defcustom filesets-save-buffer-function #'save-buffer |
| 503 | "The function used to save a buffer. | 464 | "The function used to save a buffer. |
| 504 | Caveat: Changes will take effect after rebuilding the menu." | 465 | Caveat: Changes will take effect after rebuilding the menu." |
| 505 | :set (function filesets-set-default) | 466 | :set #'filesets-set-default |
| 506 | :type '(choice :tag "Function:" | 467 | :type '(choice :tag "Function:" |
| 507 | (const :tag "save-buffer" | 468 | (const :tag "save-buffer" |
| 508 | :value save-buffer) | 469 | :value save-buffer) |
| 509 | (function :tag "Function" | 470 | (function :tag "Function" |
| 510 | :value nil)) | 471 | :value nil))) |
| 511 | :group 'filesets) | ||
| 512 | 472 | ||
| 513 | (defcustom filesets-find-file-delay | 473 | (defcustom filesets-find-file-delay |
| 514 | (if (and (featurep 'xemacs) gutter-buffers-tab-visible-p) | 474 | (if (and (featurep 'xemacs) gutter-buffers-tab-visible-p) |
| @@ -519,29 +479,25 @@ This is for calls via `filesets-find-or-display-file' | |||
| 519 | or `filesets-find-file'. | 479 | or `filesets-find-file'. |
| 520 | 480 | ||
| 521 | Set this to 0, if you don't use XEmacs's buffer tabs." | 481 | Set this to 0, if you don't use XEmacs's buffer tabs." |
| 522 | :set (function filesets-set-default) | 482 | :set #'filesets-set-default |
| 523 | :type 'number | 483 | :type 'number) |
| 524 | :group 'filesets) | ||
| 525 | 484 | ||
| 526 | (defcustom filesets-be-docile-flag nil | 485 | (defcustom filesets-be-docile-flag nil |
| 527 | "Non-nil means don't complain if a file or a directory doesn't exist. | 486 | "Non-nil means don't complain if a file or a directory doesn't exist. |
| 528 | This is useful if you want to use the same startup files in different | 487 | This is useful if you want to use the same startup files in different |
| 529 | computer environments." | 488 | computer environments." |
| 530 | :set (function filesets-set-default) | 489 | :set #'filesets-set-default |
| 531 | :type 'boolean | 490 | :type 'boolean) |
| 532 | :group 'filesets) | ||
| 533 | 491 | ||
| 534 | (defcustom filesets-sort-menu-flag t | 492 | (defcustom filesets-sort-menu-flag t |
| 535 | "Non-nil means sort the filesets menu alphabetically." | 493 | "Non-nil means sort the filesets menu alphabetically." |
| 536 | :set (function filesets-set-default) | 494 | :set #'filesets-set-default |
| 537 | :type 'boolean | 495 | :type 'boolean) |
| 538 | :group 'filesets) | ||
| 539 | 496 | ||
| 540 | (defcustom filesets-sort-case-sensitive-flag t | 497 | (defcustom filesets-sort-case-sensitive-flag t |
| 541 | "Non-nil means sorting of the filesets menu is case sensitive." | 498 | "Non-nil means sorting of the filesets menu is case sensitive." |
| 542 | :set (function filesets-set-default) | 499 | :set #'filesets-set-default |
| 543 | :type 'boolean | 500 | :type 'boolean) |
| 544 | :group 'filesets) | ||
| 545 | 501 | ||
| 546 | (defcustom filesets-tree-max-level 3 | 502 | (defcustom filesets-tree-max-level 3 |
| 547 | "Maximum scan depth for directory trees. | 503 | "Maximum scan depth for directory trees. |
| @@ -561,9 +517,8 @@ i.e. how deep the menu should be. Try something like | |||
| 561 | 517 | ||
| 562 | and it should become clear what this option is about. In any case, | 518 | and it should become clear what this option is about. In any case, |
| 563 | including directory trees to the menu can take a lot of memory." | 519 | including directory trees to the menu can take a lot of memory." |
| 564 | :set (function filesets-set-default) | 520 | :set #'filesets-set-default |
| 565 | :type 'integer | 521 | :type 'integer) |
| 566 | :group 'filesets) | ||
| 567 | 522 | ||
| 568 | (defcustom filesets-commands | 523 | (defcustom filesets-commands |
| 569 | '(("Isearch" | 524 | '(("Isearch" |
| @@ -590,7 +545,7 @@ function that returns one) to be run on a filesets' files. | |||
| 590 | 545 | ||
| 591 | The argument <file-name> or <<file-name>> (quoted) will be replaced with | 546 | The argument <file-name> or <<file-name>> (quoted) will be replaced with |
| 592 | the filename." | 547 | the filename." |
| 593 | :set (function filesets-set-default+) | 548 | :set #'filesets-set-default+ |
| 594 | :type '(repeat :tag "Commands" | 549 | :type '(repeat :tag "Commands" |
| 595 | (list :tag "Definition" :value ("") | 550 | (list :tag "Definition" :value ("") |
| 596 | (string "Name") | 551 | (string "Name") |
| @@ -606,8 +561,7 @@ the filename." | |||
| 606 | (string :tag "Quoted File Name" | 561 | (string :tag "Quoted File Name" |
| 607 | :value "<<file-name>>") | 562 | :value "<<file-name>>") |
| 608 | (function :tag "Function" | 563 | (function :tag "Function" |
| 609 | :value nil))))) | 564 | :value nil)))))) |
| 610 | :group 'filesets) | ||
| 611 | (put 'filesets-commands 'risky-local-variable t) | 565 | (put 'filesets-commands 'risky-local-variable t) |
| 612 | 566 | ||
| 613 | (defcustom filesets-external-viewers | 567 | (defcustom filesets-external-viewers |
| @@ -627,28 +581,33 @@ the filename." | |||
| 627 | (dvi-cmd "xdvi") | 581 | (dvi-cmd "xdvi") |
| 628 | (doc-cmd "antiword") | 582 | (doc-cmd "antiword") |
| 629 | (pic-cmd "gqview")) | 583 | (pic-cmd "gqview")) |
| 630 | `(("^.+\\..?html?$" browse-url | 584 | `((".\\..?html?\\'" browse-url |
| 631 | ((:ignore-on-open-all t))) | 585 | ((:ignore-on-open-all t))) |
| 632 | ("^.+\\.pdf$" ,pdf-cmd | 586 | (".\\.pdf\\'" ,pdf-cmd |
| 633 | ((:ignore-on-open-all t) | 587 | ((:ignore-on-open-all t) |
| 634 | (:ignore-on-read-text t) | 588 | (:ignore-on-read-text t) |
| 635 | (:constraint-flag ,pdf-cmd))) | 589 | ;; (:constraintp ,pdf-cmd) |
| 636 | ("^.+\\.e?ps\\(.gz\\)?$" ,ps-cmd | 590 | )) |
| 591 | (".\\.e?ps\\(?:\\.gz\\)?\\'" ,ps-cmd | ||
| 637 | ((:ignore-on-open-all t) | 592 | ((:ignore-on-open-all t) |
| 638 | (:ignore-on-read-text t) | 593 | (:ignore-on-read-text t) |
| 639 | (:constraint-flag ,ps-cmd))) | 594 | ;; (:constraintp ,ps-cmd) |
| 640 | ("^.+\\.dvi$" ,dvi-cmd | 595 | )) |
| 596 | (".\\.dvi\\'" ,dvi-cmd | ||
| 641 | ((:ignore-on-open-all t) | 597 | ((:ignore-on-open-all t) |
| 642 | (:ignore-on-read-text t) | 598 | (:ignore-on-read-text t) |
| 643 | (:constraint-flag ,dvi-cmd))) | 599 | ;; (:constraintp ,dvi-cmd) |
| 644 | ("^.+\\.doc$" ,doc-cmd | 600 | )) |
| 601 | (".\\.doc\\'" ,doc-cmd | ||
| 645 | ((:capture-output t) | 602 | ((:capture-output t) |
| 646 | (:ignore-on-read-text t) | 603 | (:ignore-on-read-text t) |
| 647 | (:constraint-flag ,doc-cmd))) | 604 | ;; (:constraintp ,doc-cmd) |
| 648 | ("^.+\\.\\(tiff\\|xpm\\|gif\\|pgn\\)$" ,pic-cmd | 605 | )) |
| 606 | (".\\.\\(tiff\\|xpm\\|gif\\|pgn\\)\\'" ,pic-cmd | ||
| 649 | ((:ignore-on-open-all t) | 607 | ((:ignore-on-open-all t) |
| 650 | (:ignore-on-read-text t) | 608 | (:ignore-on-read-text t) |
| 651 | (:constraint-flag ,pic-cmd))))) | 609 | ;; (:constraintp ,pic-cmd) |
| 610 | )))) | ||
| 652 | "Association list of file patterns and external viewers for use with | 611 | "Association list of file patterns and external viewers for use with |
| 653 | `filesets-find-or-display-file'. | 612 | `filesets-find-or-display-file'. |
| 654 | 613 | ||
| @@ -665,10 +624,8 @@ i.e. on open-all-files-events or when running commands | |||
| 665 | 624 | ||
| 666 | :constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil | 625 | :constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil |
| 667 | 626 | ||
| 668 | :constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil | 627 | :open-hook FUNCTIONs ... run FUNCTIONs after spawning the viewer -- mainly |
| 669 | 628 | useful in conjunction with :capture-output | |
| 670 | :open-hook HOOK ... run hooks after spawning the viewer -- mainly useful | ||
| 671 | in conjunction with :capture-output | ||
| 672 | 629 | ||
| 673 | :args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments | 630 | :args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments |
| 674 | \(defaults to (list \"%S\")) when using shell commands | 631 | \(defaults to (list \"%S\")) when using shell commands |
| @@ -693,7 +650,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these: | |||
| 693 | (:constraintp (lambda () | 650 | (:constraintp (lambda () |
| 694 | (and (filesets-which-command-p \"rtf2htm\") | 651 | (and (filesets-which-command-p \"rtf2htm\") |
| 695 | (filesets-which-command-p \"w3m\"))))))" | 652 | (filesets-which-command-p \"w3m\"))))))" |
| 696 | :set (function filesets-set-default) | 653 | :set #'filesets-set-default |
| 697 | :type '(repeat :tag "Viewer" | 654 | :type '(repeat :tag "Viewer" |
| 698 | (list :tag "Definition" | 655 | (list :tag "Definition" |
| 699 | :value ("^.+\\.suffix$" "") | 656 | :value ("^.+\\.suffix$" "") |
| @@ -708,7 +665,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these: | |||
| 708 | (const :format "" | 665 | (const :format "" |
| 709 | :value :constraintp) | 666 | :value :constraintp) |
| 710 | (function :tag "Function")) | 667 | (function :tag "Function")) |
| 711 | (list :tag ":constraint-flag" | 668 | (list :tag ":constraint-flag (obsolete)" |
| 712 | :value (:constraint-flag) | 669 | :value (:constraint-flag) |
| 713 | (const :format "" | 670 | (const :format "" |
| 714 | :value :constraint-flag) | 671 | :value :constraint-flag) |
| @@ -749,8 +706,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these: | |||
| 749 | :value (:capture-output t) | 706 | :value (:capture-output t) |
| 750 | (const :format "" | 707 | (const :format "" |
| 751 | :value :capture-output) | 708 | :value :capture-output) |
| 752 | (boolean :tag "Boolean")))))) | 709 | (boolean :tag "Boolean"))))))) |
| 753 | :group 'filesets) | ||
| 754 | (put 'filesets-external-viewers 'risky-local-variable t) | 710 | (put 'filesets-external-viewers 'risky-local-variable t) |
| 755 | 711 | ||
| 756 | (defcustom filesets-ingroup-patterns | 712 | (defcustom filesets-ingroup-patterns |
| @@ -891,7 +847,7 @@ With duplicates removed, it would be: | |||
| 891 | 847 | ||
| 892 | M + A - X | 848 | M + A - X |
| 893 | B" | 849 | B" |
| 894 | :set (function filesets-set-default) | 850 | :set #'filesets-set-default |
| 895 | :type '(repeat | 851 | :type '(repeat |
| 896 | :tag "Include" | 852 | :tag "Include" |
| 897 | (list | 853 | (list |
| @@ -937,8 +893,7 @@ With duplicates removed, it would be: | |||
| 937 | (list :tag ":preprocess" | 893 | (list :tag ":preprocess" |
| 938 | :value (:preprocess) | 894 | :value (:preprocess) |
| 939 | (const :format "" :value :preprocess) | 895 | (const :format "" :value :preprocess) |
| 940 | (function :tag "Function"))))))) | 896 | (function :tag "Function")))))))) |
| 941 | :group 'filesets) | ||
| 942 | (put 'filesets-ingroup-patterns 'risky-local-variable t) | 897 | (put 'filesets-ingroup-patterns 'risky-local-variable t) |
| 943 | 898 | ||
| 944 | (defcustom filesets-data nil | 899 | (defcustom filesets-data nil |
| @@ -1009,8 +964,7 @@ is used. | |||
| 1009 | 964 | ||
| 1010 | Before using :ingroup, make sure that the file type is already | 965 | Before using :ingroup, make sure that the file type is already |
| 1011 | defined in `filesets-ingroup-patterns'." | 966 | defined in `filesets-ingroup-patterns'." |
| 1012 | :group 'filesets | 967 | :set #'filesets-data-set-default |
| 1013 | :set (function filesets-data-set-default) | ||
| 1014 | :type '(repeat | 968 | :type '(repeat |
| 1015 | (cons :tag "Fileset" | 969 | (cons :tag "Fileset" |
| 1016 | (string :tag "Name" :value "") | 970 | (string :tag "Name" :value "") |
| @@ -1072,9 +1026,8 @@ defined in `filesets-ingroup-patterns'." | |||
| 1072 | 1026 | ||
| 1073 | (defcustom filesets-query-user-limit 15 | 1027 | (defcustom filesets-query-user-limit 15 |
| 1074 | "Query the user before opening a fileset with that many files." | 1028 | "Query the user before opening a fileset with that many files." |
| 1075 | :set (function filesets-set-default) | 1029 | :set #'filesets-set-default |
| 1076 | :type 'integer | 1030 | :type 'integer) |
| 1077 | :group 'filesets) | ||
| 1078 | 1031 | ||
| 1079 | 1032 | ||
| 1080 | (defun filesets-filter-dir-names (lst &optional negative) | 1033 | (defun filesets-filter-dir-names (lst &optional negative) |
| @@ -1127,16 +1080,16 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1127 | (string-match-p pattern this)) | 1080 | (string-match-p pattern this)) |
| 1128 | (filesets-message 5 "Filesets: matched dir %S with pattern %S" | 1081 | (filesets-message 5 "Filesets: matched dir %S with pattern %S" |
| 1129 | this pattern) | 1082 | this pattern) |
| 1130 | (setq dirs (cons this dirs)))) | 1083 | (push this dirs))) |
| 1131 | (t | 1084 | (t |
| 1132 | (when (or (not pattern) | 1085 | (when (or (not pattern) |
| 1133 | (string-match-p pattern this)) | 1086 | (string-match-p pattern this)) |
| 1134 | (filesets-message 5 "Filesets: matched file %S with pattern %S" | 1087 | (filesets-message 5 "Filesets: matched file %S with pattern %S" |
| 1135 | this pattern) | 1088 | this pattern) |
| 1136 | (setq files (cons (if full-flag | 1089 | (push (if full-flag |
| 1137 | (concat (file-name-as-directory dir) this) | 1090 | (concat (file-name-as-directory dir) this) |
| 1138 | this) | 1091 | this) |
| 1139 | files)))))) | 1092 | files))))) |
| 1140 | (cond | 1093 | (cond |
| 1141 | ((equal what ':dirs) | 1094 | ((equal what ':dirs) |
| 1142 | (filesets-conditional-sort dirs)) | 1095 | (filesets-conditional-sort dirs)) |
| @@ -1193,7 +1146,7 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1193 | (defun filesets-convert-path-list (string) | 1146 | (defun filesets-convert-path-list (string) |
| 1194 | "Return a path-list given as STRING as list." | 1147 | "Return a path-list given as STRING as list." |
| 1195 | (if string | 1148 | (if string |
| 1196 | (mapcar (lambda (x) (file-name-as-directory x)) | 1149 | (mapcar #'file-name-as-directory |
| 1197 | (split-string string path-separator)) | 1150 | (split-string string path-separator)) |
| 1198 | nil)) | 1151 | nil)) |
| 1199 | 1152 | ||
| @@ -1203,17 +1156,17 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1203 | filename))) | 1156 | filename))) |
| 1204 | (if (file-exists-p f) | 1157 | (if (file-exists-p f) |
| 1205 | f | 1158 | f |
| 1206 | (filesets-some | 1159 | (cl-some |
| 1207 | (lambda (dir) | 1160 | (lambda (dir) |
| 1208 | (let ((dir (file-name-as-directory dir)) | 1161 | (let ((dir (file-name-as-directory dir)) |
| 1209 | (files (if (file-exists-p dir) | 1162 | (files (if (file-exists-p dir) |
| 1210 | (filesets-directory-files dir nil ':files) | 1163 | (filesets-directory-files dir nil ':files) |
| 1211 | nil))) | 1164 | nil))) |
| 1212 | (filesets-some (lambda (file) | 1165 | (cl-some (lambda (file) |
| 1213 | (if (equal filename (file-name-nondirectory file)) | 1166 | (if (equal filename (file-name-nondirectory file)) |
| 1214 | (concat dir file) | 1167 | (concat dir file) |
| 1215 | nil)) | 1168 | nil)) |
| 1216 | files))) | 1169 | files))) |
| 1217 | path-list)))) | 1170 | path-list)))) |
| 1218 | 1171 | ||
| 1219 | 1172 | ||
| @@ -1223,12 +1176,14 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1223 | 1176 | ||
| 1224 | (defun filesets-eviewer-constraint-p (entry) | 1177 | (defun filesets-eviewer-constraint-p (entry) |
| 1225 | (let* ((props (filesets-eviewer-get-props entry)) | 1178 | (let* ((props (filesets-eviewer-get-props entry)) |
| 1226 | (constraint (assoc ':constraintp props)) | 1179 | (constraint (assoc :constraintp props)) |
| 1227 | (constraint-flag (assoc ':constraint-flag props))) | 1180 | (constraint-flag (assoc :constraint-flag props))) |
| 1228 | (cond | 1181 | (cond |
| 1229 | (constraint | 1182 | (constraint |
| 1230 | (funcall (cadr constraint))) | 1183 | (funcall (cadr constraint))) |
| 1231 | (constraint-flag | 1184 | (constraint-flag |
| 1185 | (message "Obsolete :constraint-flag %S, use :constraintp instead" | ||
| 1186 | (cadr constraint-flag)) | ||
| 1232 | (eval (cadr constraint-flag))) | 1187 | (eval (cadr constraint-flag))) |
| 1233 | (t | 1188 | (t |
| 1234 | t)))) | 1189 | t)))) |
| @@ -1236,7 +1191,7 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1236 | (defun filesets-get-external-viewer (file) | 1191 | (defun filesets-get-external-viewer (file) |
| 1237 | "Find an external viewer for FILE." | 1192 | "Find an external viewer for FILE." |
| 1238 | (let ((filename (file-name-nondirectory file))) | 1193 | (let ((filename (file-name-nondirectory file))) |
| 1239 | (filesets-some | 1194 | (cl-some |
| 1240 | (lambda (entry) | 1195 | (lambda (entry) |
| 1241 | (when (and (string-match-p (nth 0 entry) filename) | 1196 | (when (and (string-match-p (nth 0 entry) filename) |
| 1242 | (filesets-eviewer-constraint-p entry)) | 1197 | (filesets-eviewer-constraint-p entry)) |
| @@ -1246,7 +1201,7 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1246 | (defun filesets-get-external-viewer-by-name (name) | 1201 | (defun filesets-get-external-viewer-by-name (name) |
| 1247 | "Get the external viewer definition called NAME." | 1202 | "Get the external viewer definition called NAME." |
| 1248 | (when name | 1203 | (when name |
| 1249 | (filesets-some | 1204 | (cl-some |
| 1250 | (lambda (entry) | 1205 | (lambda (entry) |
| 1251 | (when (and (string-equal (nth 1 entry) name) | 1206 | (when (and (string-equal (nth 1 entry) name) |
| 1252 | (filesets-eviewer-constraint-p entry)) | 1207 | (filesets-eviewer-constraint-p entry)) |
| @@ -1308,17 +1263,13 @@ Use the viewer defined in EV-ENTRY (a valid element of | |||
| 1308 | (oh (filesets-filetype-get-prop ':open-hook file entry)) | 1263 | (oh (filesets-filetype-get-prop ':open-hook file entry)) |
| 1309 | (args (let ((fmt (filesets-filetype-get-prop ':args file entry))) | 1264 | (args (let ((fmt (filesets-filetype-get-prop ':args file entry))) |
| 1310 | (if fmt | 1265 | (if fmt |
| 1311 | (let ((rv "")) | 1266 | (mapconcat |
| 1312 | (dolist (this fmt rv) | 1267 | (lambda (this) |
| 1313 | (setq rv (concat rv | 1268 | (if (stringp this) (format this file) |
| 1314 | (cond | 1269 | (format "%S" (if (functionp this) |
| 1315 | ((stringp this) | 1270 | (funcall this) |
| 1316 | (format this file)) | 1271 | this)))) |
| 1317 | ((and (symbolp this) | 1272 | fmt "") |
| 1318 | (fboundp this)) | ||
| 1319 | (format "%S" (funcall this))) | ||
| 1320 | (t | ||
| 1321 | (format "%S" this))))))) | ||
| 1322 | (format "%S" file)))) | 1273 | (format "%S" file)))) |
| 1323 | (output | 1274 | (output |
| 1324 | (cond | 1275 | (cond |
| @@ -1338,13 +1289,15 @@ Use the viewer defined in EV-ENTRY (a valid element of | |||
| 1338 | (insert output) | 1289 | (insert output) |
| 1339 | (setq-local filesets-output-buffer-flag t) | 1290 | (setq-local filesets-output-buffer-flag t) |
| 1340 | (set-visited-file-name file t) | 1291 | (set-visited-file-name file t) |
| 1341 | (when oh | 1292 | (if (functionp oh) |
| 1342 | (run-hooks 'oh)) | 1293 | (funcall oh) |
| 1294 | (mapc #'funcall oh)) | ||
| 1343 | (set-buffer-modified-p nil) | 1295 | (set-buffer-modified-p nil) |
| 1344 | (setq buffer-read-only t) | 1296 | (setq buffer-read-only t) |
| 1345 | (goto-char (point-min))) | 1297 | (goto-char (point-min))) |
| 1346 | (when oh | 1298 | (if (functionp oh) |
| 1347 | (run-hooks 'oh)))) | 1299 | (funcall oh) |
| 1300 | (mapc #'funcall oh)))) | ||
| 1348 | (error "Filesets: general error when spawning external viewer")))) | 1301 | (error "Filesets: general error when spawning external viewer")))) |
| 1349 | 1302 | ||
| 1350 | (defun filesets-find-file (file) | 1303 | (defun filesets-find-file (file) |
| @@ -1355,7 +1308,8 @@ not be opened." | |||
| 1355 | (when (or (file-readable-p file) | 1308 | (when (or (file-readable-p file) |
| 1356 | (not filesets-be-docile-flag)) | 1309 | (not filesets-be-docile-flag)) |
| 1357 | (sit-for filesets-find-file-delay) | 1310 | (sit-for filesets-find-file-delay) |
| 1358 | (find-file file))) | 1311 | (with-suppressed-warnings ((interactive-only find-file)) |
| 1312 | (find-file file)))) | ||
| 1359 | 1313 | ||
| 1360 | (defun filesets-find-or-display-file (&optional file viewer) | 1314 | (defun filesets-find-or-display-file (&optional file viewer) |
| 1361 | "Visit FILE using an external VIEWER or open it in an Emacs buffer." | 1315 | "Visit FILE using an external VIEWER or open it in an Emacs buffer." |
| @@ -1394,7 +1348,8 @@ not be opened." | |||
| 1394 | (if (functionp filesets-browse-dir-function) | 1348 | (if (functionp filesets-browse-dir-function) |
| 1395 | (funcall filesets-browse-dir-function dir) | 1349 | (funcall filesets-browse-dir-function dir) |
| 1396 | (let ((name (car filesets-browse-dir-function)) | 1350 | (let ((name (car filesets-browse-dir-function)) |
| 1397 | (args (format (cadr filesets-browse-dir-function) (expand-file-name dir)))) | 1351 | (args (format (cadr filesets-browse-dir-function) |
| 1352 | (expand-file-name dir)))) | ||
| 1398 | (with-temp-buffer | 1353 | (with-temp-buffer |
| 1399 | (start-process (concat "Filesets:" name) | 1354 | (start-process (concat "Filesets:" name) |
| 1400 | "*Filesets external directory browser*" | 1355 | "*Filesets external directory browser*" |
| @@ -1445,7 +1400,7 @@ Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil." | |||
| 1445 | "Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup. | 1400 | "Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup. |
| 1446 | See `filesets-data'." | 1401 | See `filesets-data'." |
| 1447 | (let ((data (filesets-data-get-data entry))) | 1402 | (let ((data (filesets-data-get-data entry))) |
| 1448 | (filesets-some | 1403 | (cl-some |
| 1449 | (lambda (x) | 1404 | (lambda (x) |
| 1450 | (if (assoc x data) | 1405 | (if (assoc x data) |
| 1451 | x)) | 1406 | x)) |
| @@ -1557,16 +1512,15 @@ SAVE-FUNCTION takes no argument, but works on the current buffer." | |||
| 1557 | (assoc cmd-name filesets-commands)) | 1512 | (assoc cmd-name filesets-commands)) |
| 1558 | 1513 | ||
| 1559 | (defun filesets-cmd-get-args (cmd-name) | 1514 | (defun filesets-cmd-get-args (cmd-name) |
| 1560 | (let ((args (let ((def (filesets-cmd-get-def cmd-name))) | 1515 | (mapcan (lambda (this) |
| 1561 | (nth 2 def))) | 1516 | (cond |
| 1562 | (rv nil)) | 1517 | ((and (symbolp this) (fboundp this)) |
| 1563 | (dolist (this args rv) | 1518 | (let ((x (funcall this))) |
| 1564 | (cond | 1519 | (if (listp x) x (list x)))) |
| 1565 | ((and (symbolp this) (fboundp this)) | 1520 | (t |
| 1566 | (let ((x (funcall this))) | 1521 | (list this)))) |
| 1567 | (setq rv (append rv (if (listp x) x (list x)))))) | 1522 | (let ((def (filesets-cmd-get-def cmd-name))) |
| 1568 | (t | 1523 | (nth 2 def)))) |
| 1569 | (setq rv (append rv (list this)))))))) | ||
| 1570 | 1524 | ||
| 1571 | (defun filesets-cmd-get-fn (cmd-name) | 1525 | (defun filesets-cmd-get-fn (cmd-name) |
| 1572 | (let ((def (filesets-cmd-get-def cmd-name))) | 1526 | (let ((def (filesets-cmd-get-def cmd-name))) |
| @@ -1628,28 +1582,24 @@ Replace <file-name> or <<file-name>> with filename." | |||
| 1628 | (cond | 1582 | (cond |
| 1629 | ((stringp fn) | 1583 | ((stringp fn) |
| 1630 | (let* ((args | 1584 | (let* ((args |
| 1631 | (let ((txt "")) | 1585 | (mapconcat |
| 1632 | (dolist (this args txt) | 1586 | (lambda (this) |
| 1633 | (setq txt | 1587 | (filesets-run-cmd--repl-fn |
| 1634 | (concat txt | ||
| 1635 | (if (equal txt "") "" " ") | ||
| 1636 | (filesets-run-cmd--repl-fn | ||
| 1637 | this | 1588 | this |
| 1638 | (lambda (this) | 1589 | (lambda (this) |
| 1639 | (format "%s" this)))))))) | 1590 | (format "%s" this)))) |
| 1591 | args | ||
| 1592 | " ")) | ||
| 1640 | (cmd (concat fn " " args))) | 1593 | (cmd (concat fn " " args))) |
| 1641 | (filesets-cmd-show-result | 1594 | (filesets-cmd-show-result |
| 1642 | cmd (shell-command-to-string cmd)))) | 1595 | cmd (shell-command-to-string cmd)))) |
| 1643 | ((symbolp fn) | 1596 | ((symbolp fn) |
| 1644 | (let ((args | 1597 | (apply fn |
| 1645 | (let ((argl nil)) | 1598 | (mapcan (lambda (this) |
| 1646 | (dolist (this args argl) | 1599 | (filesets-run-cmd--repl-fn |
| 1647 | (setq argl | 1600 | this |
| 1648 | (append argl | 1601 | 'list)) |
| 1649 | (filesets-run-cmd--repl-fn | 1602 | args))))))))))))))))) |
| 1650 | this | ||
| 1651 | 'list))))))) | ||
| 1652 | (apply fn args))))))))))))))))) | ||
| 1653 | 1603 | ||
| 1654 | (defun filesets-get-cmd-menu () | 1604 | (defun filesets-get-cmd-menu () |
| 1655 | "Create filesets command menu." | 1605 | "Create filesets command menu." |
| @@ -1832,8 +1782,8 @@ User will be queried, if no fileset name is provided." | |||
| 1832 | (if entry | 1782 | (if entry |
| 1833 | (let* ((files (filesets-entry-get-files entry)) | 1783 | (let* ((files (filesets-entry-get-files entry)) |
| 1834 | (this (buffer-file-name buffer)) | 1784 | (this (buffer-file-name buffer)) |
| 1835 | (inlist (filesets-member this files | 1785 | (inlist (cl-member this files |
| 1836 | :test 'filesets-files-equalp))) | 1786 | :test #'filesets-files-equalp))) |
| 1837 | (cond | 1787 | (cond |
| 1838 | (inlist | 1788 | (inlist |
| 1839 | (message "Filesets: `%s' is already in `%s'" this name)) | 1789 | (message "Filesets: `%s' is already in `%s'" this name)) |
| @@ -1858,8 +1808,8 @@ User will be queried, if no fileset name is provided." | |||
| 1858 | (if entry | 1808 | (if entry |
| 1859 | (let* ((files (filesets-entry-get-files entry)) | 1809 | (let* ((files (filesets-entry-get-files entry)) |
| 1860 | (this (buffer-file-name buffer)) | 1810 | (this (buffer-file-name buffer)) |
| 1861 | (inlist (filesets-member this files | 1811 | (inlist (cl-member this files |
| 1862 | :test 'filesets-files-equalp))) | 1812 | :test #'filesets-files-equalp))) |
| 1863 | ;;(message "%s %s %s" files this inlist) | 1813 | ;;(message "%s %s %s" files this inlist) |
| 1864 | (if (and files this inlist) | 1814 | (if (and files this inlist) |
| 1865 | (let ((new (list (cons ':files (delete (car inlist) files))))) | 1815 | (let ((new (list (cons ':files (delete (car inlist) files))))) |
| @@ -1908,7 +1858,7 @@ User will be queried, if no fileset name is provided." | |||
| 1908 | (substring (elt submenu 0) 2)))) | 1858 | (substring (elt submenu 0) 2)))) |
| 1909 | (if (listp submenu) | 1859 | (if (listp submenu) |
| 1910 | (cons name (cdr submenu)) | 1860 | (cons name (cdr submenu)) |
| 1911 | (apply 'vector (list name (cadr (append submenu nil))))))) | 1861 | (apply #'vector (list name (cadr (append submenu nil))))))) |
| 1912 | ; (vconcat `[,name] (subseq submenu 1))))) | 1862 | ; (vconcat `[,name] (subseq submenu 1))))) |
| 1913 | 1863 | ||
| 1914 | (defun filesets-wrap-submenu (submenu-body) | 1864 | (defun filesets-wrap-submenu (submenu-body) |
| @@ -1926,12 +1876,14 @@ User will be queried, if no fileset name is provided." | |||
| 1926 | ((or (> count bl) | 1876 | ((or (> count bl) |
| 1927 | (null data))) | 1877 | (null data))) |
| 1928 | ;; (let ((sl (subseq submenu-body count | 1878 | ;; (let ((sl (subseq submenu-body count |
| 1929 | (let ((sl (filesets-sublist submenu-body count | 1879 | (let ((sl (seq-subseq submenu-body count |
| 1930 | (let ((x (+ count factor))) | 1880 | (let ((x (+ count factor))) |
| 1931 | (if (>= bl x) | 1881 | (if (>= bl x) |
| 1932 | x | 1882 | x |
| 1933 | nil))))) | 1883 | nil))))) |
| 1934 | (when sl | 1884 | (when sl |
| 1885 | ;; FIXME: O(n²) performance bug because of repeated `append': | ||
| 1886 | ;; use `mapcan'? | ||
| 1935 | (setq result | 1887 | (setq result |
| 1936 | (append | 1888 | (append |
| 1937 | result | 1889 | result |
| @@ -1948,6 +1900,8 @@ User will be queried, if no fileset name is provided." | |||
| 1948 | (if (null (cdr x)) | 1900 | (if (null (cdr x)) |
| 1949 | "" | 1901 | "" |
| 1950 | ", ")))) | 1902 | ", ")))) |
| 1903 | ;; FIXME: O(n²) performance bug because of | ||
| 1904 | ;; repeated `concat': use `mapconcat'? | ||
| 1951 | (setq rv | 1905 | (setq rv |
| 1952 | (concat | 1906 | (concat |
| 1953 | rv | 1907 | rv |
| @@ -2023,11 +1977,11 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." | |||
| 2023 | (and (stringp a) | 1977 | (and (stringp a) |
| 2024 | (stringp b) | 1978 | (stringp b) |
| 2025 | (string-match-p a b)))))) | 1979 | (string-match-p a b)))))) |
| 2026 | (filesets-some (lambda (x) | 1980 | (cl-some (lambda (x) |
| 2027 | (if (funcall fn (car x) masterfile) | 1981 | (if (funcall fn (car x) masterfile) |
| 2028 | (nth pos x) | 1982 | (nth pos x) |
| 2029 | nil)) | 1983 | nil)) |
| 2030 | filesets-ingroup-patterns))) | 1984 | filesets-ingroup-patterns))) |
| 2031 | 1985 | ||
| 2032 | (defun filesets-ingroup-get-pattern (master) | 1986 | (defun filesets-ingroup-get-pattern (master) |
| 2033 | "Access to `filesets-ingroup-patterns'. Extract patterns." | 1987 | "Access to `filesets-ingroup-patterns'. Extract patterns." |
| @@ -2039,12 +1993,8 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." | |||
| 2039 | 1993 | ||
| 2040 | (defun filesets-ingroup-collect-finder (patt case-sensitivep) | 1994 | (defun filesets-ingroup-collect-finder (patt case-sensitivep) |
| 2041 | "Helper function for `filesets-ingroup-collect'. Find pattern PATT." | 1995 | "Helper function for `filesets-ingroup-collect'. Find pattern PATT." |
| 2042 | (let ((cfs case-fold-search) | 1996 | (let ((case-fold-search (not case-sensitivep))) |
| 2043 | (rv (progn | 1997 | (re-search-forward patt nil t))) |
| 2044 | (setq case-fold-search (not case-sensitivep)) | ||
| 2045 | (re-search-forward patt nil t)))) | ||
| 2046 | (setq case-fold-search cfs) | ||
| 2047 | rv)) | ||
| 2048 | 1998 | ||
| 2049 | (defun filesets-ingroup-cache-get (master) | 1999 | (defun filesets-ingroup-cache-get (master) |
| 2050 | "Access to `filesets-ingroup-cache'." | 2000 | "Access to `filesets-ingroup-cache'." |
| @@ -2102,9 +2052,9 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." | |||
| 2102 | (when (and f | 2052 | (when (and f |
| 2103 | (not (member f flist)) | 2053 | (not (member f flist)) |
| 2104 | (or (not remdupl-flag) | 2054 | (or (not remdupl-flag) |
| 2105 | (not (filesets-member | 2055 | (not (cl-member |
| 2106 | f filesets-ingroup-files | 2056 | f filesets-ingroup-files |
| 2107 | :test 'filesets-files-equalp)))) | 2057 | :test #'filesets-files-equalp)))) |
| 2108 | (let ((no-stub-flag | 2058 | (let ((no-stub-flag |
| 2109 | (and (not this-stub-flag) | 2059 | (and (not this-stub-flag) |
| 2110 | (if this-stubp | 2060 | (if this-stubp |
| @@ -2116,16 +2066,18 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." | |||
| 2116 | (cons f filesets-ingroup-files)) | 2066 | (cons f filesets-ingroup-files)) |
| 2117 | (when no-stub-flag | 2067 | (when no-stub-flag |
| 2118 | (filesets-ingroup-cache-put master f)) | 2068 | (filesets-ingroup-cache-put master f)) |
| 2119 | (setq lst (append lst (list f)))))))) | 2069 | (push f lst)))))) |
| 2120 | (when lst | 2070 | (when lst |
| 2121 | (setq rv | 2071 | (setq rv |
| 2072 | ;; FIXME: O(n²) performance bug because of repeated | ||
| 2073 | ;; `nconc'. | ||
| 2122 | (nconc rv | 2074 | (nconc rv |
| 2123 | (mapcar (lambda (this) | 2075 | (mapcar (lambda (this) |
| 2124 | `((,this ,this-name) | 2076 | `((,this ,this-name) |
| 2125 | ,@(filesets-ingroup-collect-files | 2077 | ,@(filesets-ingroup-collect-files |
| 2126 | fs remdupl-flag this | 2078 | fs remdupl-flag this |
| 2127 | (- this-sd 1)))) | 2079 | (- this-sd 1)))) |
| 2128 | lst)))))))) | 2080 | (nreverse lst))))))))) |
| 2129 | (filesets-message 2 "Filesets: no patterns defined for %S" master))))) | 2081 | (filesets-message 2 "Filesets: no patterns defined for %S" master))))) |
| 2130 | 2082 | ||
| 2131 | (defun filesets-ingroup-collect-build-menu (fs flist &optional other-count) | 2083 | (defun filesets-ingroup-collect-build-menu (fs flist &optional other-count) |
| @@ -2135,42 +2087,41 @@ FS is a fileset's name. FLIST is a list returned by | |||
| 2135 | (if (null flist) | 2087 | (if (null flist) |
| 2136 | nil | 2088 | nil |
| 2137 | (let ((count 0) | 2089 | (let ((count 0) |
| 2138 | (fsn fs) | 2090 | (fsn fs)) |
| 2139 | (rv nil)) | 2091 | (mapcan (lambda (this) |
| 2140 | (dolist (this flist rv) | 2092 | (setq count (+ count 1)) |
| 2141 | (setq count (+ count 1)) | 2093 | (let* ((def (if (listp this) (car this) (list this ""))) |
| 2142 | (let* ((def (if (listp this) (car this) (list this ""))) | 2094 | (files (if (listp this) (cdr this) nil)) |
| 2143 | (files (if (listp this) (cdr this) nil)) | 2095 | (master (nth 0 def)) |
| 2144 | (master (nth 0 def)) | 2096 | (name (nth 1 def)) |
| 2145 | (name (nth 1 def)) | 2097 | (nm (concat (filesets-get-shortcut |
| 2146 | (nm (concat (filesets-get-shortcut (if (or (not other-count) files) | 2098 | (if (or (not other-count) files) |
| 2147 | count other-count)) | 2099 | count other-count)) |
| 2148 | (if (or (null name) (equal name "")) | 2100 | (if (or (null name) (equal name "")) |
| 2149 | "" | 2101 | "" |
| 2150 | (format "%s: " name)) | 2102 | (format "%s: " name)) |
| 2151 | (file-name-nondirectory master)))) | 2103 | (file-name-nondirectory master)))) |
| 2152 | (setq rv | 2104 | (if files |
| 2153 | (append rv | 2105 | `((,nm |
| 2154 | (if files | 2106 | [,(concat "Inclusion Group: " |
| 2155 | `((,nm | 2107 | (file-name-nondirectory master)) |
| 2156 | [,(concat "Inclusion Group: " | 2108 | (filesets-open ':ingroup ',master ',fsn)] |
| 2157 | (file-name-nondirectory master)) | 2109 | "---" |
| 2158 | (filesets-open ':ingroup ',master ',fsn)] | 2110 | [,master (filesets-file-open nil ',master ',fsn)] |
| 2159 | "---" | 2111 | "---" |
| 2160 | [,master (filesets-file-open nil ',master ',fsn)] | 2112 | ,@(let ((count 0)) |
| 2161 | "---" | 2113 | (mapcar |
| 2162 | ,@(let ((count 0)) | 2114 | (lambda (this) |
| 2163 | (mapcar | 2115 | (setq count (+ count 1)) |
| 2164 | (lambda (this) | 2116 | (let ((ff (filesets-ingroup-collect-build-menu |
| 2165 | (setq count (+ count 1)) | 2117 | fs (list this) count))) |
| 2166 | (let ((ff (filesets-ingroup-collect-build-menu | 2118 | (if (= (length ff) 1) |
| 2167 | fs (list this) count))) | 2119 | (car ff) |
| 2168 | (if (= (length ff) 1) | 2120 | ff))) |
| 2169 | (car ff) | 2121 | files)) |
| 2170 | ff))) | 2122 | ,@(filesets-get-menu-epilog master ':ingroup fsn))) |
| 2171 | files)) | 2123 | `([,nm (filesets-file-open nil ',master ',fsn)])))) |
| 2172 | ,@(filesets-get-menu-epilog master ':ingroup fsn))) | 2124 | flist)))) |
| 2173 | `([,nm (filesets-file-open nil ',master ',fsn)]))))))))) | ||
| 2174 | 2125 | ||
| 2175 | (defun filesets-ingroup-collect (fs remdupl-flag master) | 2126 | (defun filesets-ingroup-collect (fs remdupl-flag master) |
| 2176 | "Collect names of included files and build submenu." | 2127 | "Collect names of included files and build submenu." |
| @@ -2275,7 +2226,7 @@ Construct a shortcut from COUNT." | |||
| 2275 | (:pattern | 2226 | (:pattern |
| 2276 | (let* ((files (filesets-get-filelist entry mode 'on-ls)) | 2227 | (let* ((files (filesets-get-filelist entry mode 'on-ls)) |
| 2277 | (dirpatt (filesets-entry-get-pattern entry)) | 2228 | (dirpatt (filesets-entry-get-pattern entry)) |
| 2278 | (pattname (apply 'concat (cons "Pattern: " dirpatt))) | 2229 | (pattname (apply #'concat (cons "Pattern: " dirpatt))) |
| 2279 | (count 0)) | 2230 | (count 0)) |
| 2280 | ;;(filesets-message 3 "Filesets: scanning %S" pattname) | 2231 | ;;(filesets-message 3 "Filesets: scanning %S" pattname) |
| 2281 | `([,pattname | 2232 | `([,pattname |
| @@ -2418,14 +2369,14 @@ fileset thinks this is necessary or not." | |||
| 2418 | (dolist (this filesets-menu-cache-contents) | 2369 | (dolist (this filesets-menu-cache-contents) |
| 2419 | (if (get this 'custom-type) | 2370 | (if (get this 'custom-type) |
| 2420 | (progn | 2371 | (progn |
| 2421 | (insert (format "(setq-default %s '%S)" this (eval this))) | 2372 | (insert (format "(setq-default %s '%S)" this (eval this t))) |
| 2422 | (when filesets-menu-ensure-use-cached | 2373 | (when filesets-menu-ensure-use-cached |
| 2423 | (newline) | 2374 | (newline) |
| 2424 | (insert (format "(setq %s (cons '%s %s))" | 2375 | (insert (format "(setq %s (cons '%s %s))" |
| 2425 | 'filesets-ignore-next-set-default | 2376 | 'filesets-ignore-next-set-default |
| 2426 | this | 2377 | this |
| 2427 | 'filesets-ignore-next-set-default)))) | 2378 | 'filesets-ignore-next-set-default)))) |
| 2428 | (insert (format "(setq %s '%S)" this (eval this)))) | 2379 | (insert (format "(setq %s '%S)" this (eval this t)))) |
| 2429 | (newline 2)) | 2380 | (newline 2)) |
| 2430 | (insert (format "(setq filesets-cache-version %S)" filesets-version)) | 2381 | (insert (format "(setq filesets-cache-version %S)" filesets-version)) |
| 2431 | (newline 2) | 2382 | (newline 2) |
| @@ -2526,9 +2477,9 @@ We apologize for the inconvenience."))) | |||
| 2526 | "Filesets initialization. | 2477 | "Filesets initialization. |
| 2527 | Set up hooks, load the cache file -- if existing -- and build the menu." | 2478 | Set up hooks, load the cache file -- if existing -- and build the menu." |
| 2528 | (add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe) | 2479 | (add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe) |
| 2529 | (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl)) | 2480 | (add-hook 'kill-buffer-hook #'filesets-remove-from-ubl) |
| 2530 | (add-hook 'first-change-hook (function filesets-reset-filename-on-change)) | 2481 | (add-hook 'first-change-hook #'filesets-reset-filename-on-change) |
| 2531 | (add-hook 'kill-emacs-hook (function filesets-exit)) | 2482 | (add-hook 'kill-emacs-hook #'filesets-exit) |
| 2532 | (if (filesets-menu-cache-file-load) | 2483 | (if (filesets-menu-cache-file-load) |
| 2533 | (progn | 2484 | (progn |
| 2534 | (filesets-build-menu-maybe) | 2485 | (filesets-build-menu-maybe) |
| @@ -2542,7 +2493,7 @@ Set up hooks, load the cache file -- if existing -- and build the menu." | |||
| 2542 | (defun filesets-error (_class &rest args) | 2493 | (defun filesets-error (_class &rest args) |
| 2543 | "`error' wrapper." | 2494 | "`error' wrapper." |
| 2544 | (declare (obsolete error "28.1")) | 2495 | (declare (obsolete error "28.1")) |
| 2545 | (error "%s" (mapconcat 'identity args " "))) | 2496 | (error "%s" (mapconcat #'identity args " "))) |
| 2546 | 2497 | ||
| 2547 | (provide 'filesets) | 2498 | (provide 'filesets) |
| 2548 | 2499 | ||
diff --git a/lisp/font-core.el b/lisp/font-core.el index 38307bb1576..0f1a3d1c364 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; font-core.el --- Core interface to font-lock | 1 | ;;; font-core.el --- Core interface to font-lock -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1992-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1992-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
diff --git a/lisp/format.el b/lisp/format.el index df3bc462c92..4209fc6401a 100644 --- a/lisp/format.el +++ b/lisp/format.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; format.el --- read and save files in multiple formats | 1 | ;;; format.el --- read and save files in multiple formats -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1994-1995, 1997, 1999, 2001-2021 Free Software | 3 | ;; Copyright (C) 1994-1995, 1997, 1999, 2001-2021 Free Software |
| 4 | ;; Foundation, Inc. | 4 | ;; Foundation, Inc. |
| @@ -419,7 +419,8 @@ If FORMAT is nil then do not do any format conversion." | |||
| 419 | (file-name-nondirectory file))))) | 419 | (file-name-nondirectory file))))) |
| 420 | (list file fmt))) | 420 | (list file fmt))) |
| 421 | (let ((format-alist nil)) | 421 | (let ((format-alist nil)) |
| 422 | (find-file filename)) | 422 | (with-suppressed-warnings ((interactive-only find-file)) |
| 423 | (find-file filename))) | ||
| 423 | (if format | 424 | (if format |
| 424 | (format-decode-buffer format))) | 425 | (format-decode-buffer format))) |
| 425 | 426 | ||
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 18924a3ad0e..3fb8e469d04 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el | |||
| @@ -145,7 +145,6 @@ used to display Gnus windows." | |||
| 145 | (,shell-command-buffer-name 1.0))) | 145 | (,shell-command-buffer-name 1.0))) |
| 146 | (bug | 146 | (bug |
| 147 | (vertical 1.0 | 147 | (vertical 1.0 |
| 148 | (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) | ||
| 149 | ("*Gnus Bug*" 1.0 point))) | 148 | ("*Gnus Bug*" 1.0 point))) |
| 150 | (score-trace | 149 | (score-trace |
| 151 | (vertical 1.0 | 150 | (vertical 1.0 |
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 61946aa5811..2b0b61bfac6 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el | |||
| @@ -1264,11 +1264,20 @@ in HANDLE." | |||
| 1264 | (when (and (mm-handle-buffer handle) | 1264 | (when (and (mm-handle-buffer handle) |
| 1265 | (buffer-name (mm-handle-buffer handle))) | 1265 | (buffer-name (mm-handle-buffer handle))) |
| 1266 | (with-temp-buffer | 1266 | (with-temp-buffer |
| 1267 | (mm-disable-multibyte) | 1267 | (if (and (eq (mm-handle-encoding handle) '8bit) |
| 1268 | (insert-buffer-substring (mm-handle-buffer handle)) | 1268 | (with-current-buffer (mm-handle-buffer handle) |
| 1269 | (mm-decode-content-transfer-encoding | 1269 | enable-multibyte-characters)) |
| 1270 | (mm-handle-encoding handle) | 1270 | ;; Due to unfortunate historical reasons, we may have a |
| 1271 | (mm-handle-media-type handle)) | 1271 | ;; multibyte buffer here, but if it's using an 8bit |
| 1272 | ;; Content-Transfer-Encoding, then work around that by | ||
| 1273 | ;; just ignoring the situation. | ||
| 1274 | (insert-buffer-substring (mm-handle-buffer handle)) | ||
| 1275 | ;; Do the decoding. | ||
| 1276 | (mm-disable-multibyte) | ||
| 1277 | (insert-buffer-substring (mm-handle-buffer handle)) | ||
| 1278 | (mm-decode-content-transfer-encoding | ||
| 1279 | (mm-handle-encoding handle) | ||
| 1280 | (mm-handle-media-type handle))) | ||
| 1272 | ,@forms)))) | 1281 | ,@forms)))) |
| 1273 | (put 'mm-with-part 'lisp-indent-function 1) | 1282 | (put 'mm-with-part 'lisp-indent-function 1) |
| 1274 | (put 'mm-with-part 'edebug-form-spec '(body)) | 1283 | (put 'mm-with-part 'edebug-form-spec '(body)) |
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 68c31dc4510..e4fd976742c 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el | |||
| @@ -494,7 +494,7 @@ This variable is set by `nnmaildir-request-article'.") | |||
| 494 | (delete-char 1) | 494 | (delete-char 1) |
| 495 | (setq nov (nnheader-parse-head t) | 495 | (setq nov (nnheader-parse-head t) |
| 496 | field (or (mail-header-lines nov) 0))) | 496 | field (or (mail-header-lines nov) 0))) |
| 497 | (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:)) | 497 | (unless (or (<= field 0) (nnmaildir--param pgname 'distrust-Lines:)) |
| 498 | (setq nov-mid field)) | 498 | (setq nov-mid field)) |
| 499 | (setq nov-mid (number-to-string nov-mid) | 499 | (setq nov-mid (number-to-string nov-mid) |
| 500 | nov-mid (concat (number-to-string attr) "\t" nov-mid)) | 500 | nov-mid (concat (number-to-string attr) "\t" nov-mid)) |
diff --git a/lisp/info.el b/lisp/info.el index ef94aa945f2..62d7b583ff2 100644 --- a/lisp/info.el +++ b/lisp/info.el | |||
| @@ -160,17 +160,14 @@ A header-line does not scroll with the rest of the buffer." | |||
| 160 | :version "24.4") | 160 | :version "24.4") |
| 161 | 161 | ||
| 162 | ;; This is a defcustom largely so that we can get the benefit | 162 | ;; This is a defcustom largely so that we can get the benefit |
| 163 | ;; of custom-initialize-delay. Perhaps it would work to make it a | 163 | ;; of `custom-initialize-delay'. Perhaps it would work to make it a |
| 164 | ;; defvar and explicitly give it a standard-value property, and | 164 | ;; `defvar' and explicitly give it a `standard-value' property, and |
| 165 | ;; call custom-initialize-delay on it. | 165 | ;; call `custom-initialize-delay' on it. |
| 166 | ;; The progn forces the autoloader to include the whole thing, not | 166 | ;; The value is initialized at startup time, when command-line calls |
| 167 | ;; just an abbreviated version. The value is initialized at startup | 167 | ;; `custom-reevaluate-setting' on all the defcustoms in |
| 168 | ;; time, when command-line calls custom-reevaluate-setting on all | 168 | ;; `custom-delayed-init-variables'. This is somewhat sub-optimal, as ideally |
| 169 | ;; the defcustoms in custom-delayed-init-variables. This is | 169 | ;; this should be done when Info mode is first invoked. |
| 170 | ;; somewhat sub-optimal, as ideally this should be done when Info | ||
| 171 | ;; mode is first invoked. | ||
| 172 | ;;;###autoload | 170 | ;;;###autoload |
| 173 | (progn | ||
| 174 | (defcustom Info-default-directory-list | 171 | (defcustom Info-default-directory-list |
| 175 | (let* ((config-dir | 172 | (let* ((config-dir |
| 176 | (file-name-as-directory | 173 | (file-name-as-directory |
| @@ -232,8 +229,8 @@ the environment variable INFOPATH is set. | |||
| 232 | Although this is a customizable variable, that is mainly for technical | 229 | Although this is a customizable variable, that is mainly for technical |
| 233 | reasons. Normally, you should either set INFOPATH or customize | 230 | reasons. Normally, you should either set INFOPATH or customize |
| 234 | `Info-additional-directory-list', rather than changing this variable." | 231 | `Info-additional-directory-list', rather than changing this variable." |
| 235 | :initialize 'custom-initialize-delay | 232 | :initialize #'custom-initialize-delay |
| 236 | :type '(repeat directory))) | 233 | :type '(repeat directory)) |
| 237 | 234 | ||
| 238 | (defvar Info-directory-list nil | 235 | (defvar Info-directory-list nil |
| 239 | "List of directories to search for Info documentation files. | 236 | "List of directories to search for Info documentation files. |
diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 6924e1c06db..9bce419b489 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; characters.el --- set syntax and category for multibyte characters | 1 | ;;; characters.el --- set syntax and category for multibyte characters -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
| @@ -526,9 +526,6 @@ with L, LRE, or LRO Unicode bidi character type.") | |||
| 526 | ;; FIXME: We should probably just use the Unicode properties to set | 526 | ;; FIXME: We should probably just use the Unicode properties to set |
| 527 | ;; up the syntax table. | 527 | ;; up the syntax table. |
| 528 | 528 | ||
| 529 | ;; NBSP isn't semantically interchangeable with other whitespace chars, | ||
| 530 | ;; so it's more like punctuation. | ||
| 531 | (set-case-syntax ? "." tbl) | ||
| 532 | (set-case-syntax ?¡ "." tbl) | 529 | (set-case-syntax ?¡ "." tbl) |
| 533 | (set-case-syntax ?¦ "_" tbl) | 530 | (set-case-syntax ?¦ "_" tbl) |
| 534 | (set-case-syntax ?§ "." tbl) | 531 | (set-case-syntax ?§ "." tbl) |
| @@ -602,11 +599,17 @@ with L, LRE, or LRO Unicode bidi character type.") | |||
| 602 | ;; Cyrillic Extended-C | 599 | ;; Cyrillic Extended-C |
| 603 | (modify-category-entry '(#x1C80 . #x1C8F) ?y) | 600 | (modify-category-entry '(#x1C80 . #x1C8F) ?y) |
| 604 | 601 | ||
| 605 | ;; general punctuation | 602 | ;; space characters (see section 6.2 in the Unicode Standard) |
| 603 | (set-case-syntax ? " " tbl) | ||
| 606 | (setq c #x2000) | 604 | (setq c #x2000) |
| 607 | (while (<= c #x200b) | 605 | (while (<= c #x200b) |
| 608 | (set-case-syntax c " " tbl) | 606 | (set-case-syntax c " " tbl) |
| 609 | (setq c (1+ c))) | 607 | (setq c (1+ c))) |
| 608 | (let ((chars '(#x202F #x205F #x3000))) | ||
| 609 | (while chars | ||
| 610 | (set-case-syntax (car chars) " " tbl) | ||
| 611 | (setq chars (cdr chars)))) | ||
| 612 | ;; general punctuation | ||
| 610 | (while (<= c #x200F) | 613 | (while (<= c #x200F) |
| 611 | (set-case-syntax c "." tbl) | 614 | (set-case-syntax c "." tbl) |
| 612 | (setq c (1+ c))) | 615 | (setq c (1+ c))) |
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 4d80e17e3db..14e7b89dd1f 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; fontset.el --- commands for handling fontset | 1 | ;;; fontset.el --- commands for handling fontset -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index 8b5814e577c..2c7da2b7cdf 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8 -*- | 1 | ;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1987, 1993-1999, 2001-2021 Free Software Foundation, | 3 | ;; Copyright (C) 1987, 1993-1999, 2001-2021 Free Software Foundation, |
| 4 | ;; Inc. | 4 | ;; Inc. |
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 662f211bd28..64aac46fcee 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; mule-conf.el --- configure multilingual environment | 1 | ;;; mule-conf.el --- configure multilingual environment -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 | 4 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 |
diff --git a/lisp/international/mule.el b/lisp/international/mule.el index d3a1005dae5..6a32cffe9a6 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; mule.el --- basic commands for multilingual environment | 1 | ;;; mule.el --- basic commands for multilingual environment -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index d1b5c077813..0f8dedfc09b 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC | 1 | ;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -185,7 +185,7 @@ | |||
| 185 | ;; always returns nil, something the code here doesn't like. | 185 | ;; always returns nil, something the code here doesn't like. |
| 186 | (define-char-code-property 'decomposition "uni-decomposition.el") | 186 | (define-char-code-property 'decomposition "uni-decomposition.el") |
| 187 | (define-char-code-property 'canonical-combining-class "uni-combining.el") | 187 | (define-char-code-property 'canonical-combining-class "uni-combining.el") |
| 188 | (let ((char 0) ccc decomposition) | 188 | (let (ccc decomposition) |
| 189 | (mapc | 189 | (mapc |
| 190 | (lambda (start-end) | 190 | (lambda (start-end) |
| 191 | (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) | 191 | (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) |
diff --git a/lisp/isearch.el b/lisp/isearch.el index fefdd16d25b..67cc7bed15b 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el | |||
| @@ -669,6 +669,10 @@ This is like `describe-bindings', but displays only Isearch keys." | |||
| 669 | (if isearch-success 'isearch-abort binding)))) | 669 | (if isearch-success 'isearch-abort binding)))) |
| 670 | map)) | 670 | map)) |
| 671 | 671 | ||
| 672 | ;; Note: Before adding more key bindings to this map, please keep in | ||
| 673 | ;; mind that any unbound key exits Isearch and runs the command bound | ||
| 674 | ;; to it in the local or global map. So in effect every key unbound | ||
| 675 | ;; in this map is implicitly bound. | ||
| 672 | (defvar isearch-mode-map | 676 | (defvar isearch-mode-map |
| 673 | (let ((i 0) | 677 | (let ((i 0) |
| 674 | (map (make-keymap))) | 678 | (map (make-keymap))) |
| @@ -834,6 +838,10 @@ This is like `describe-bindings', but displays only Isearch keys." | |||
| 834 | :image '(isearch-tool-bar-image "left-arrow"))) | 838 | :image '(isearch-tool-bar-image "left-arrow"))) |
| 835 | map)) | 839 | map)) |
| 836 | 840 | ||
| 841 | ;; Note: Before adding more key bindings to this map, please keep in | ||
| 842 | ;; mind that any unbound key exits Isearch and runs the command bound | ||
| 843 | ;; to it in the local or global map. So in effect every key unbound | ||
| 844 | ;; in this map is implicitly bound. | ||
| 837 | (defvar minibuffer-local-isearch-map | 845 | (defvar minibuffer-local-isearch-map |
| 838 | (let ((map (make-sparse-keymap))) | 846 | (let ((map (make-sparse-keymap))) |
| 839 | (set-keymap-parent map minibuffer-local-map) | 847 | (set-keymap-parent map minibuffer-local-map) |
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 3c7d2a057d5..11d93a6df9a 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el | 1 | ;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2021 Free Software | 3 | ;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2021 Free Software |
| 4 | ;; Foundation, Inc. | 4 | ;; Foundation, Inc. |
| @@ -93,6 +93,7 @@ Otherwise, it is nil.") | |||
| 93 | "\\)" file-name-version-regexp "?\\'")))) | 93 | "\\)" file-name-version-regexp "?\\'")))) |
| 94 | 94 | ||
| 95 | ;; Functions for accessing the return value of jka-compr-get-compression-info | 95 | ;; Functions for accessing the return value of jka-compr-get-compression-info |
| 96 | ;; FIXME: Use cl-defstruct! | ||
| 96 | (defun jka-compr-info-regexp (info) (aref info 0)) | 97 | (defun jka-compr-info-regexp (info) (aref info 0)) |
| 97 | (defun jka-compr-info-compress-message (info) (aref info 1)) | 98 | (defun jka-compr-info-compress-message (info) (aref info 1)) |
| 98 | (defun jka-compr-info-compress-program (info) (aref info 2)) | 99 | (defun jka-compr-info-compress-program (info) (aref info 2)) |
diff --git a/lisp/json.el b/lisp/json.el index f5659d81efa..1f1f608eaba 100644 --- a/lisp/json.el +++ b/lisp/json.el | |||
| @@ -55,7 +55,6 @@ | |||
| 55 | ;;; Code: | 55 | ;;; Code: |
| 56 | 56 | ||
| 57 | (require 'map) | 57 | (require 'map) |
| 58 | (require 'seq) | ||
| 59 | (require 'subr-x) | 58 | (require 'subr-x) |
| 60 | 59 | ||
| 61 | ;; Parameters | 60 | ;; Parameters |
| @@ -655,7 +654,9 @@ become JSON objects." | |||
| 655 | (defun json-encode-array (array) | 654 | (defun json-encode-array (array) |
| 656 | "Return a JSON representation of ARRAY." | 655 | "Return a JSON representation of ARRAY." |
| 657 | (if (and json-encoding-pretty-print | 656 | (if (and json-encoding-pretty-print |
| 658 | (not (seq-empty-p array))) | 657 | (if (listp array) |
| 658 | array | ||
| 659 | (> (length array) 0))) | ||
| 659 | (concat | 660 | (concat |
| 660 | "[" | 661 | "[" |
| 661 | (json--with-indentation | 662 | (json--with-indentation |
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el index 6b434feb137..5cb8344c094 100644 --- a/lisp/language/chinese.el +++ b/lisp/language/chinese.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; chinese.el --- support for Chinese -*- coding: utf-8; -*- | 1 | ;;; chinese.el --- support for Chinese -*- coding: utf-8; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el index c491644d57c..c12096f95eb 100644 --- a/lisp/language/cyrillic.el +++ b/lisp/language/cyrillic.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; -*- | 1 | ;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/language/english.el b/lisp/language/english.el index dfbec85792f..41d56be7d46 100644 --- a/lisp/language/english.el +++ b/lisp/language/english.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; english.el --- support for English | 1 | ;;; english.el --- support for English -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, | 4 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, |
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el index 1e409e3dcf8..8573f6177df 100644 --- a/lisp/language/ethiopic.el +++ b/lisp/language/ethiopic.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; -*- | 1 | ;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/language/european.el b/lisp/language/european.el index 1f27ff0c73b..bcd62a14c4c 100644 --- a/lisp/language/european.el +++ b/lisp/language/european.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; european.el --- support for European languages -*- coding: utf-8; -*- | 1 | ;;; european.el --- support for European languages -*- coding: utf-8; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el index 9f9a14a0dc0..389565669a9 100644 --- a/lisp/language/hebrew.el +++ b/lisp/language/hebrew.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; hebrew.el --- support for Hebrew -*- coding: utf-8 -*- | 1 | ;;; hebrew.el --- support for Hebrew -*- coding: utf-8; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/language/indian.el b/lisp/language/indian.el index b92fda53648..5ff57966c12 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; indian.el --- Indian languages support -*- coding: utf-8; -*- | 1 | ;;; indian.el --- Indian languages support -*- coding: utf-8; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 | 4 | ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 |
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el index 8c724ee9667..bd8ef6ec857 100644 --- a/lisp/language/japanese.el +++ b/lisp/language/japanese.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; japanese.el --- support for Japanese | 1 | ;;; japanese.el --- support for Japanese -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/language/korean.el b/lisp/language/korean.el index 997b8ae1319..22b33a440ef 100644 --- a/lisp/language/korean.el +++ b/lisp/language/korean.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; korean.el --- support for Korean -*- coding: utf-8 -*- | 1 | ;;; korean.el --- support for Korean -*- coding: utf-8; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/language/lao.el b/lisp/language/lao.el index 44fe8d230db..5252f1e60ea 100644 --- a/lisp/language/lao.el +++ b/lisp/language/lao.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; lao.el --- support for Lao -*- coding: utf-8 -*- | 1 | ;;; lao.el --- support for Lao -*- coding: utf-8; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, | 4 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, |
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index 089b79c5208..0a274f144c2 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; misc-lang.el --- support for miscellaneous languages (characters) | 1 | ;;; misc-lang.el --- support for miscellaneous languages (characters) -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 3 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 |
diff --git a/lisp/language/thai.el b/lisp/language/thai.el index 44a9a319330..be15db49db9 100644 --- a/lisp/language/thai.el +++ b/lisp/language/thai.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; thai.el --- support for Thai -*- coding: utf-8 -*- | 1 | ;;; thai.el --- support for Thai -*- coding: utf-8; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 4 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el index 5b8e29c2c7a..edd9d765b1e 100644 --- a/lisp/language/tibetan.el +++ b/lisp/language/tibetan.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; -*- | 1 | ;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, | 4 | ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, |
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el index f4de299f537..2e583a470d6 100644 --- a/lisp/mail/reporter.el +++ b/lisp/mail/reporter.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; reporter.el --- customizable bug reporting of lisp programs | 1 | ;;; reporter.el --- customizable bug reporting of lisp programs -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1993-1998, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1993-1998, 2001-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -158,7 +158,7 @@ composed.") | |||
| 158 | t) | 158 | t) |
| 159 | (error indent-enclosing-p)))) | 159 | (error indent-enclosing-p)))) |
| 160 | 160 | ||
| 161 | (defun reporter-lisp-indent (indent-point state) | 161 | (defun reporter-lisp-indent (_indent-point state) |
| 162 | "A better lisp indentation style for bug reporting." | 162 | "A better lisp indentation style for bug reporting." |
| 163 | (save-excursion | 163 | (save-excursion |
| 164 | (goto-char (1+ (nth 1 state))) | 164 | (goto-char (1+ (nth 1 state))) |
| @@ -193,7 +193,7 @@ MAILBUF is the mail buffer being composed." | |||
| 193 | (<= maxwidth (current-column))) | 193 | (<= maxwidth (current-column))) |
| 194 | (save-excursion | 194 | (save-excursion |
| 195 | (let ((compact-p (not (memq varsym reporter-dont-compact-list))) | 195 | (let ((compact-p (not (memq varsym reporter-dont-compact-list))) |
| 196 | (lisp-indent-function 'reporter-lisp-indent)) | 196 | (lisp-indent-function #'reporter-lisp-indent)) |
| 197 | (goto-char here) | 197 | (goto-char here) |
| 198 | (reporter-beautify-list maxwidth compact-p)))) | 198 | (reporter-beautify-list maxwidth compact-p)))) |
| 199 | (insert "\n")) | 199 | (insert "\n")) |
| @@ -206,6 +206,11 @@ MAILBUF is the mail buffer being composed." | |||
| 206 | (error | 206 | (error |
| 207 | (error "")))) | 207 | (error "")))) |
| 208 | 208 | ||
| 209 | (defun reporter--run-functions (funs) | ||
| 210 | (if (functionp funs) | ||
| 211 | (funcall funs) | ||
| 212 | (mapc #'funcall funs))) | ||
| 213 | |||
| 209 | (defun reporter-dump-state (pkgname varlist pre-hooks post-hooks) | 214 | (defun reporter-dump-state (pkgname varlist pre-hooks post-hooks) |
| 210 | "Dump the state of the mode specific variables. | 215 | "Dump the state of the mode specific variables. |
| 211 | PKGNAME contains the name of the mode as it will appear in the bug | 216 | PKGNAME contains the name of the mode as it will appear in the bug |
| @@ -230,42 +235,39 @@ properly. | |||
| 230 | PRE-HOOKS is run after the Emacs version and PKGNAME are inserted, but | 235 | PRE-HOOKS is run after the Emacs version and PKGNAME are inserted, but |
| 231 | before the VARLIST is dumped. POST-HOOKS is run after the VARLIST is | 236 | before the VARLIST is dumped. POST-HOOKS is run after the VARLIST is |
| 232 | dumped." | 237 | dumped." |
| 233 | (let ((buffer (current-buffer))) | 238 | (insert "Emacs : " (emacs-version) "\n") |
| 234 | (set-buffer buffer) | 239 | (and pkgname |
| 235 | (insert "Emacs : " (emacs-version) "\n") | 240 | (insert "Package: " pkgname "\n")) |
| 236 | (and pkgname | 241 | (reporter--run-functions pre-hooks) |
| 237 | (insert "Package: " pkgname "\n")) | 242 | (if (not varlist) |
| 238 | (run-hooks 'pre-hooks) | 243 | nil |
| 239 | (if (not varlist) | 244 | (insert "\ncurrent state:\n==============\n") |
| 240 | nil | 245 | ;; create an emacs-lisp-mode buffer to contain the output, which |
| 241 | (insert "\ncurrent state:\n==============\n") | 246 | ;; we'll later insert into the mail buffer |
| 242 | ;; create an emacs-lisp-mode buffer to contain the output, which | 247 | (condition-case fault |
| 243 | ;; we'll later insert into the mail buffer | 248 | (let ((mailbuf (current-buffer)) |
| 244 | (condition-case fault | 249 | (elbuf (get-buffer-create " *tmp-reporter-buffer*"))) |
| 245 | (let ((mailbuf (current-buffer)) | 250 | (with-current-buffer elbuf |
| 246 | (elbuf (get-buffer-create " *tmp-reporter-buffer*"))) | 251 | (emacs-lisp-mode) |
| 247 | (with-current-buffer elbuf | 252 | (erase-buffer) |
| 248 | (emacs-lisp-mode) | 253 | (insert "(setq\n") |
| 249 | (erase-buffer) | 254 | (lisp-indent-line) |
| 250 | (insert "(setq\n") | 255 | (mapc |
| 251 | (lisp-indent-line) | 256 | (lambda (varsym-or-cons-cell) |
| 252 | (mapc | 257 | (let ((varsym (or (car-safe varsym-or-cons-cell) |
| 253 | (lambda (varsym-or-cons-cell) | 258 | varsym-or-cons-cell)) |
| 254 | (let ((varsym (or (car-safe varsym-or-cons-cell) | 259 | (printer (or (cdr-safe varsym-or-cons-cell) |
| 255 | varsym-or-cons-cell)) | 260 | 'reporter-dump-variable))) |
| 256 | (printer (or (cdr-safe varsym-or-cons-cell) | 261 | (funcall printer varsym mailbuf))) |
| 257 | 'reporter-dump-variable))) | 262 | varlist) |
| 258 | (funcall printer varsym mailbuf))) | 263 | (lisp-indent-line) |
| 259 | varlist) | 264 | (insert ")\n")) |
| 260 | (lisp-indent-line) | 265 | (insert-buffer-substring elbuf)) |
| 261 | (insert ")\n")) | 266 | (error |
| 262 | (insert-buffer-substring elbuf)) | 267 | (insert "State could not be dumped due to the following error:\n\n" |
| 263 | (error | 268 | (format "%s" fault) |
| 264 | (insert "State could not be dumped due to the following error:\n\n" | 269 | "\n\nYou should still send this bug report.")))) |
| 265 | (format "%s" fault) | 270 | (reporter--run-functions post-hooks)) |
| 266 | "\n\nYou should still send this bug report.")))) | ||
| 267 | (run-hooks 'post-hooks) | ||
| 268 | )) | ||
| 269 | 271 | ||
| 270 | 272 | ||
| 271 | (defun reporter-compose-outgoing () | 273 | (defun reporter-compose-outgoing () |
| @@ -365,7 +367,7 @@ mail-sending package is used for editing and sending the message." | |||
| 365 | (skip-chars-backward " \t\n") | 367 | (skip-chars-backward " \t\n") |
| 366 | (setq reporter-initial-text (buffer-substring after-sep-pos (point)))) | 368 | (setq reporter-initial-text (buffer-substring after-sep-pos (point)))) |
| 367 | (if (setq hookvar (get agent 'hookvar)) | 369 | (if (setq hookvar (get agent 'hookvar)) |
| 368 | (add-hook hookvar 'reporter-bug-hook nil t)) | 370 | (add-hook hookvar #'reporter-bug-hook nil t)) |
| 369 | 371 | ||
| 370 | ;; compose the minibuf message and display this. | 372 | ;; compose the minibuf message and display this. |
| 371 | (let* ((sendkey-whereis (where-is-internal | 373 | (let* ((sendkey-whereis (where-is-internal |
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 69797837cd2..29460cc20f5 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el | |||
| @@ -161,13 +161,6 @@ its character representation and its display representation.") | |||
| 161 | :version "21.1") | 161 | :version "21.1") |
| 162 | 162 | ||
| 163 | ;;;###autoload | 163 | ;;;###autoload |
| 164 | (put 'rmail-spool-directory 'standard-value | ||
| 165 | '((cond ((file-exists-p "/var/mail") "/var/mail/") | ||
| 166 | ((file-exists-p "/var/spool/mail") "/var/spool/mail/") | ||
| 167 | ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") | ||
| 168 | (t "/usr/spool/mail/")))) | ||
| 169 | |||
| 170 | ;;;###autoload | ||
| 171 | (defcustom rmail-spool-directory | 164 | (defcustom rmail-spool-directory |
| 172 | (purecopy | 165 | (purecopy |
| 173 | (cond ((file-exists-p "/var/mail") | 166 | (cond ((file-exists-p "/var/mail") |
| @@ -181,12 +174,10 @@ its character representation and its display representation.") | |||
| 181 | (t "/usr/spool/mail/"))) | 174 | (t "/usr/spool/mail/"))) |
| 182 | "Name of directory used by system mailer for delivering new mail. | 175 | "Name of directory used by system mailer for delivering new mail. |
| 183 | Its name should end with a slash." | 176 | Its name should end with a slash." |
| 184 | :initialize 'custom-initialize-delay | 177 | :initialize #'custom-initialize-delay |
| 185 | :type 'directory | 178 | :type 'directory |
| 186 | :group 'rmail) | 179 | :group 'rmail) |
| 187 | 180 | ||
| 188 | ;;;###autoload(custom-initialize-delay 'rmail-spool-directory nil) | ||
| 189 | |||
| 190 | (defcustom rmail-movemail-program nil | 181 | (defcustom rmail-movemail-program nil |
| 191 | "If non-nil, the file name of the `movemail' program." | 182 | "If non-nil, the file name of the `movemail' program." |
| 192 | :group 'rmail-retrieve | 183 | :group 'rmail-retrieve |
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el index 06da0739d6b..f9a24e34bf2 100644 --- a/lisp/mb-depth.el +++ b/lisp/mb-depth.el | |||
| @@ -35,6 +35,11 @@ | |||
| 35 | It is called with one argument, the minibuffer depth, | 35 | It is called with one argument, the minibuffer depth, |
| 36 | and must return a string.") | 36 | and must return a string.") |
| 37 | 37 | ||
| 38 | (defface minibuffer-depth-indicator '((t :inherit highlight)) | ||
| 39 | "Face to use for minibuffer depth indicator." | ||
| 40 | :group 'minibuffer | ||
| 41 | :version "28.1") | ||
| 42 | |||
| 38 | ;; An overlay covering the prompt. This is a buffer-local variable in | 43 | ;; An overlay covering the prompt. This is a buffer-local variable in |
| 39 | ;; each affected minibuffer. | 44 | ;; each affected minibuffer. |
| 40 | ;; | 45 | ;; |
| @@ -52,7 +57,10 @@ The prompt should already have been inserted." | |||
| 52 | (overlay-put minibuffer-depth-overlay 'before-string | 57 | (overlay-put minibuffer-depth-overlay 'before-string |
| 53 | (if minibuffer-depth-indicator-function | 58 | (if minibuffer-depth-indicator-function |
| 54 | (funcall minibuffer-depth-indicator-function depth) | 59 | (funcall minibuffer-depth-indicator-function depth) |
| 55 | (propertize (format "[%d]" depth) 'face 'highlight))) | 60 | (concat (propertize (format "[%d]" depth) |
| 61 | 'face | ||
| 62 | 'minibuffer-depth-indicator) | ||
| 63 | " "))) | ||
| 56 | (overlay-put minibuffer-depth-overlay 'evaporate t)))) | 64 | (overlay-put minibuffer-depth-overlay 'evaporate t)))) |
| 57 | 65 | ||
| 58 | ;;;###autoload | 66 | ;;;###autoload |
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 65fdccd70b2..20dbb5eaa60 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; menu-bar.el --- define a default menu bar | 1 | ;;; menu-bar.el --- define a default menu bar -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -229,7 +229,8 @@ | |||
| 229 | (filename (car (find-file-read-args "Find file: " mustmatch)))) | 229 | (filename (car (find-file-read-args "Find file: " mustmatch)))) |
| 230 | (if mustmatch | 230 | (if mustmatch |
| 231 | (find-file-existing filename) | 231 | (find-file-existing filename) |
| 232 | (find-file filename)))) | 232 | (with-suppressed-warnings ((interactive-only find-file)) |
| 233 | (find-file filename))))) | ||
| 233 | 234 | ||
| 234 | ;; The "Edit->Search" submenu | 235 | ;; The "Edit->Search" submenu |
| 235 | (defvar menu-bar-last-search-type nil | 236 | (defvar menu-bar-last-search-type nil |
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el index aa34fe7f1a3..dcac36f2a4a 100644 --- a/lisp/net/pop3.el +++ b/lisp/net/pop3.el | |||
| @@ -463,7 +463,7 @@ Return non-nil if it is necessary to update the local UIDL file." | |||
| 463 | (when (cdr elt) | 463 | (when (cdr elt) |
| 464 | (insert "(\"" (pop elt) "\"\n ") | 464 | (insert "(\"" (pop elt) "\"\n ") |
| 465 | (while elt | 465 | (while elt |
| 466 | (insert (format "\"%s\" %s\n " (pop elt) (pop elt)))) | 466 | (insert (format "%S %s\n " (pop elt) (pop elt)))) |
| 467 | (delete-char -4) | 467 | (delete-char -4) |
| 468 | (insert ")\n "))) | 468 | (insert ")\n "))) |
| 469 | (delete-char -3) | 469 | (delete-char -3) |
diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 0d48fd7e05a..96fafc826b8 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el | |||
| @@ -385,6 +385,7 @@ | |||
| 385 | ) | 385 | ) |
| 386 | ) | 386 | ) |
| 387 | (process-put proc 'socks-state socks-state-authenticated) | 387 | (process-put proc 'socks-state socks-state-authenticated) |
| 388 | (process-put proc 'socks-scratch "") | ||
| 388 | (set-process-filter proc #'socks-filter))) | 389 | (set-process-filter proc #'socks-filter))) |
| 389 | proc))) | 390 | proc))) |
| 390 | 391 | ||
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 865ea4e92a4..b43b4485fec 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -2672,7 +2672,8 @@ The method used must be an out-of-band method." | |||
| 2672 | (tramp-get-remote-null-device v)))) | 2672 | (tramp-get-remote-null-device v)))) |
| 2673 | 2673 | ||
| 2674 | (save-restriction | 2674 | (save-restriction |
| 2675 | (let ((beg (point))) | 2675 | (let ((beg (point)) |
| 2676 | (emc enable-multibyte-characters)) | ||
| 2676 | (narrow-to-region (point) (point)) | 2677 | (narrow-to-region (point) (point)) |
| 2677 | ;; We cannot use `insert-buffer-substring' because the Tramp | 2678 | ;; We cannot use `insert-buffer-substring' because the Tramp |
| 2678 | ;; buffer changes its contents before insertion due to calling | 2679 | ;; buffer changes its contents before insertion due to calling |
| @@ -2681,7 +2682,9 @@ The method used must be an out-of-band method." | |||
| 2681 | (with-current-buffer (tramp-get-buffer v) | 2682 | (with-current-buffer (tramp-get-buffer v) |
| 2682 | (buffer-string))) | 2683 | (buffer-string))) |
| 2683 | 2684 | ||
| 2684 | ;; Check for "--dired" output. | 2685 | ;; Check for "--dired" output. We must enable unibyte |
| 2686 | ;; strings, because the "--dired" output counts in bytes. | ||
| 2687 | (set-buffer-multibyte nil) | ||
| 2685 | (forward-line -2) | 2688 | (forward-line -2) |
| 2686 | (when (looking-at-p "//SUBDIRED//") | 2689 | (when (looking-at-p "//SUBDIRED//") |
| 2687 | (forward-line -1)) | 2690 | (forward-line -1)) |
| @@ -2701,6 +2704,8 @@ The method used must be an out-of-band method." | |||
| 2701 | (while (looking-at "//") | 2704 | (while (looking-at "//") |
| 2702 | (forward-line 1) | 2705 | (forward-line 1) |
| 2703 | (delete-region (match-beginning 0) (point))) | 2706 | (delete-region (match-beginning 0) (point))) |
| 2707 | ;; Reset multibyte if needed. | ||
| 2708 | (set-buffer-multibyte emc) | ||
| 2704 | 2709 | ||
| 2705 | ;; Some busyboxes are reluctant to discard colors. | 2710 | ;; Some busyboxes are reluctant to discard colors. |
| 2706 | (unless | 2711 | (unless |
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index e328b6eab52..3916e35f769 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el | |||
| @@ -25,7 +25,8 @@ | |||
| 25 | ;;; Commentary: | 25 | ;;; Commentary: |
| 26 | 26 | ||
| 27 | ;; This game can be run in batch mode. To do this, use: | 27 | ;; This game can be run in batch mode. To do this, use: |
| 28 | ;; emacs -batch -l dunnet | 28 | ;; |
| 29 | ;; emacs --batch -f dunnet | ||
| 29 | 30 | ||
| 30 | ;;; Code: | 31 | ;;; Code: |
| 31 | 32 | ||
| @@ -1170,11 +1171,13 @@ treasures for points?" "4" "four") | |||
| 1170 | (defun dunnet () | 1171 | (defun dunnet () |
| 1171 | "Switch to *dungeon* buffer and start game." | 1172 | "Switch to *dungeon* buffer and start game." |
| 1172 | (interactive) | 1173 | (interactive) |
| 1173 | (pop-to-buffer-same-window "*dungeon*") | 1174 | (if noninteractive |
| 1174 | (dun-mode) | 1175 | (dun--batch) |
| 1175 | (setq dun-dead nil) | 1176 | (pop-to-buffer-same-window "*dungeon*") |
| 1176 | (setq dun-room 0) | 1177 | (dun-mode) |
| 1177 | (dun-messages)) | 1178 | (setq dun-dead nil) |
| 1179 | (setq dun-room 0) | ||
| 1180 | (dun-messages))) | ||
| 1178 | 1181 | ||
| 1179 | ;;;; | 1182 | ;;;; |
| 1180 | ;;;; This section contains all of the verbs and commands. | 1183 | ;;;; This section contains all of the verbs and commands. |
| @@ -3126,8 +3129,7 @@ File not found"))) | |||
| 3126 | (dun-mprinc "\n") | 3129 | (dun-mprinc "\n") |
| 3127 | (dun-batch-loop)) | 3130 | (dun-batch-loop)) |
| 3128 | 3131 | ||
| 3129 | ;;;###autoload | 3132 | (defun dun--batch () |
| 3130 | (defun dun-batch () | ||
| 3131 | "Start `dunnet' in batch mode." | 3133 | "Start `dunnet' in batch mode." |
| 3132 | (fset 'dun-mprinc #'dun-batch-mprinc) | 3134 | (fset 'dun-mprinc #'dun-batch-mprinc) |
| 3133 | (fset 'dun-mprincl #'dun-batch-mprincl) | 3135 | (fset 'dun-mprincl #'dun-batch-mprincl) |
| @@ -3140,6 +3142,17 @@ File not found"))) | |||
| 3140 | (setq dun-batch-mode t) | 3142 | (setq dun-batch-mode t) |
| 3141 | (dun-batch-loop)) | 3143 | (dun-batch-loop)) |
| 3142 | 3144 | ||
| 3145 | ;; Apparently, there are many references out there to running us via | ||
| 3146 | ;; | ||
| 3147 | ;; emacs --batch -l dunnet | ||
| 3148 | ;; | ||
| 3149 | ;; So try and accommodate those without interfering with other cases | ||
| 3150 | ;; where `dunnet.el' might be loaded in batch mode with no intention | ||
| 3151 | ;; to run the game. | ||
| 3152 | (when (and noninteractive | ||
| 3153 | (equal '("-l" "dunnet") (member "-l" command-line-args))) | ||
| 3154 | (dun--batch)) | ||
| 3155 | |||
| 3143 | (provide 'dunnet) | 3156 | (provide 'dunnet) |
| 3144 | 3157 | ||
| 3145 | ;; Local Variables: | 3158 | ;; Local Variables: |
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index fddc13f56b1..460af718aad 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el | |||
| @@ -4,7 +4,7 @@ | |||
| 4 | 4 | ||
| 5 | ;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> | 5 | ;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> |
| 6 | ;; Maintainer: João Távora <joaotavora@gmail.com> | 6 | ;; Maintainer: João Távora <joaotavora@gmail.com> |
| 7 | ;; Version: 1.1.0 | 7 | ;; Version: 1.1.1 |
| 8 | ;; Keywords: c languages tools | 8 | ;; Keywords: c languages tools |
| 9 | ;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0")) | 9 | ;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0")) |
| 10 | 10 | ||
| @@ -1283,6 +1283,8 @@ correctly.") | |||
| 1283 | (when (flymake-running-backends) flymake-mode-line-counter-format)) | 1283 | (when (flymake-running-backends) flymake-mode-line-counter-format)) |
| 1284 | 1284 | ||
| 1285 | (defun flymake--mode-line-counter (type &optional no-space) | 1285 | (defun flymake--mode-line-counter (type &optional no-space) |
| 1286 | "Compute number of diagnostics in buffer with TYPE's severity. | ||
| 1287 | TYPE is usually keyword `:error', `:warning' or `:note'." | ||
| 1286 | (let ((count 0) | 1288 | (let ((count 0) |
| 1287 | (face (flymake--lookup-type-property type | 1289 | (face (flymake--lookup-type-property type |
| 1288 | 'mode-line-face | 1290 | 'mode-line-face |
| @@ -1290,7 +1292,8 @@ correctly.") | |||
| 1290 | (maphash (lambda | 1292 | (maphash (lambda |
| 1291 | (_b state) | 1293 | (_b state) |
| 1292 | (dolist (d (flymake--backend-state-diags state)) | 1294 | (dolist (d (flymake--backend-state-diags state)) |
| 1293 | (when (eq type (flymake--diag-type d)) | 1295 | (when (= (flymake--severity type) |
| 1296 | (flymake--severity (flymake--diag-type d))) | ||
| 1294 | (cl-incf count)))) | 1297 | (cl-incf count)))) |
| 1295 | flymake--backend-state) | 1298 | flymake--backend-state) |
| 1296 | (when (or (cl-plusp count) | 1299 | (when (or (cl-plusp count) |
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index ec20b01a0f0..2a2a4978c62 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el | |||
| @@ -324,13 +324,33 @@ | |||
| 324 | ;; disambiguate with the left-bitshift operator. | 324 | ;; disambiguate with the left-bitshift operator. |
| 325 | "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)" | 325 | "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)" |
| 326 | ".*\\(\n\\)") | 326 | ".*\\(\n\\)") |
| 327 | (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table)) | 327 | (4 (let* ((eol (match-beginning 4)) |
| 328 | (st (get-text-property eol 'syntax-table)) | ||
| 328 | (name (match-string 2)) | 329 | (name (match-string 2)) |
| 329 | (indented (match-beginning 1))) | 330 | (indented (match-beginning 1))) |
| 330 | (goto-char (match-end 2)) | 331 | (goto-char (match-end 2)) |
| 331 | (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) | 332 | (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) |
| 333 | ;; '<<' occurred in a string, or in a comment. | ||
| 332 | ;; Leave the property of the newline unchanged. | 334 | ;; Leave the property of the newline unchanged. |
| 333 | st | 335 | st |
| 336 | ;; Beware of `foo <<'BAR' #baz` because | ||
| 337 | ;; the newline needs to start the here-doc | ||
| 338 | ;; and can't be used to close the comment. | ||
| 339 | (let ((eol-state (save-excursion (syntax-ppss eol)))) | ||
| 340 | (when (nth 4 eol-state) | ||
| 341 | (if (/= (1- eol) (nth 8 eol-state)) | ||
| 342 | ;; make the last char of the comment closing it | ||
| 343 | (put-text-property (1- eol) eol | ||
| 344 | 'syntax-table (string-to-syntax ">")) | ||
| 345 | ;; In `foo <<'BAR' #` the # is the last character | ||
| 346 | ;; before eol and can't both open and close the | ||
| 347 | ;; comment. Workaround: disguise the "#" as | ||
| 348 | ;; whitespace and fontify it as a comment. | ||
| 349 | (put-text-property (1- eol) eol | ||
| 350 | 'syntax-table (string-to-syntax "-")) | ||
| 351 | (put-text-property (1- eol) eol | ||
| 352 | 'font-lock-face | ||
| 353 | 'font-lock-comment-face)))) | ||
| 334 | (cons (car (string-to-syntax "< c")) | 354 | (cons (car (string-to-syntax "< c")) |
| 335 | ;; Remember the names of heredocs found on this line. | 355 | ;; Remember the names of heredocs found on this line. |
| 336 | (cons (cons (pcase (aref name 0) | 356 | (cons (cons (pcase (aref name 0) |
| @@ -483,8 +503,15 @@ | |||
| 483 | ;; as twoarg). | 503 | ;; as twoarg). |
| 484 | (perl-syntax-propertize-special-constructs limit))))))))) | 504 | (perl-syntax-propertize-special-constructs limit))))))))) |
| 485 | 505 | ||
| 506 | (defface perl-heredoc | ||
| 507 | '((t (:inherit font-lock-string-face))) | ||
| 508 | "The face for here-documents. Inherits from font-lock-string-face.") | ||
| 509 | |||
| 486 | (defun perl-font-lock-syntactic-face-function (state) | 510 | (defun perl-font-lock-syntactic-face-function (state) |
| 487 | (cond | 511 | (cond |
| 512 | ((and (eq 2 (nth 7 state)) ; c-style comment | ||
| 513 | (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) ; HERE doc | ||
| 514 | 'perl-heredoc) | ||
| 488 | ((and (nth 3 state) | 515 | ((and (nth 3 state) |
| 489 | (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) | 516 | (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) |
| 490 | ;; This is a second-arg of s{..}{...} form; let's check if this second | 517 | ;; This is a second-arg of s{..}{...} form; let's check if this second |
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index d417382c0df..62c3cf44cb6 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el | |||
| @@ -291,7 +291,8 @@ to find the list of ignores for each directory." | |||
| 291 | (localdir (file-local-name (expand-file-name dir))) | 291 | (localdir (file-local-name (expand-file-name dir))) |
| 292 | (command (format "%s %s %s -type f %s -print0" | 292 | (command (format "%s %s %s -type f %s -print0" |
| 293 | find-program | 293 | find-program |
| 294 | localdir | 294 | ;; In case DIR is a symlink. |
| 295 | (file-name-as-directory localdir) | ||
| 295 | (xref--find-ignores-arguments ignores localdir) | 296 | (xref--find-ignores-arguments ignores localdir) |
| 296 | (if files | 297 | (if files |
| 297 | (concat (shell-quote-argument "(") | 298 | (concat (shell-quote-argument "(") |
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 3effb6ed662..a8667acb9d5 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el | |||
| @@ -1598,13 +1598,16 @@ See `add-log-current-defun-function'." | |||
| 1598 | (let* ((indent 0) mname mlist | 1598 | (let* ((indent 0) mname mlist |
| 1599 | (start (point)) | 1599 | (start (point)) |
| 1600 | (make-definition-re | 1600 | (make-definition-re |
| 1601 | (lambda (re) | 1601 | (lambda (re &optional method-name?) |
| 1602 | (concat "^[ \t]*" re "[ \t]+" | 1602 | (concat "^[ \t]*" re "[ \t]+" |
| 1603 | "\\(" | 1603 | "\\(" |
| 1604 | ;; \\. and :: for class methods | 1604 | ;; \\. and :: for class methods |
| 1605 | "\\([A-Za-z_]" ruby-symbol-re "*[?!]?\\|\\.\\|::" "\\)" | 1605 | "\\([A-Za-z_]" ruby-symbol-re "*[?!]?" |
| 1606 | "\\|" | ||
| 1607 | (if method-name? ruby-operator-re "\\.") | ||
| 1608 | "\\|::" "\\)" | ||
| 1606 | "+\\)"))) | 1609 | "+\\)"))) |
| 1607 | (definition-re (funcall make-definition-re ruby-defun-beg-re)) | 1610 | (definition-re (funcall make-definition-re ruby-defun-beg-re t)) |
| 1608 | (module-re (funcall make-definition-re "\\(class\\|module\\)"))) | 1611 | (module-re (funcall make-definition-re "\\(class\\|module\\)"))) |
| 1609 | ;; Get the current method definition (or class/module). | 1612 | ;; Get the current method definition (or class/module). |
| 1610 | (when (re-search-backward definition-re nil t) | 1613 | (when (re-search-backward definition-re nil t) |
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 2fefc23e199..d3b6ae71a0a 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el | |||
| @@ -928,8 +928,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." | |||
| 928 | (or | 928 | (or |
| 929 | (assoc-default 'fetched-xrefs alist) | 929 | (assoc-default 'fetched-xrefs alist) |
| 930 | (funcall fetcher))) | 930 | (funcall fetcher))) |
| 931 | (xref-alist (xref--analyze xrefs))) | 931 | (xref-alist (xref--analyze xrefs)) |
| 932 | (dd default-directory)) | ||
| 932 | (with-current-buffer (get-buffer-create xref-buffer-name) | 933 | (with-current-buffer (get-buffer-create xref-buffer-name) |
| 934 | (setq default-directory dd) | ||
| 933 | (xref--xref-buffer-mode) | 935 | (xref--xref-buffer-mode) |
| 934 | (xref--show-common-initialize xref-alist fetcher alist) | 936 | (xref--show-common-initialize xref-alist fetcher alist) |
| 935 | (pop-to-buffer (current-buffer)) | 937 | (pop-to-buffer (current-buffer)) |
| @@ -992,13 +994,15 @@ When only one definition found, jump to it right away instead." | |||
| 992 | When there is more than one definition, split the selected window | 994 | When there is more than one definition, split the selected window |
| 993 | and show the list in a small window at the bottom. And use a | 995 | and show the list in a small window at the bottom. And use a |
| 994 | local keymap that binds `RET' to `xref-quit-and-goto-xref'." | 996 | local keymap that binds `RET' to `xref-quit-and-goto-xref'." |
| 995 | (let ((xrefs (funcall fetcher))) | 997 | (let ((xrefs (funcall fetcher)) |
| 998 | (dd default-directory)) | ||
| 996 | (cond | 999 | (cond |
| 997 | ((not (cdr xrefs)) | 1000 | ((not (cdr xrefs)) |
| 998 | (xref-pop-to-location (car xrefs) | 1001 | (xref-pop-to-location (car xrefs) |
| 999 | (assoc-default 'display-action alist))) | 1002 | (assoc-default 'display-action alist))) |
| 1000 | (t | 1003 | (t |
| 1001 | (with-current-buffer (get-buffer-create xref-buffer-name) | 1004 | (with-current-buffer (get-buffer-create xref-buffer-name) |
| 1005 | (setq default-directory dd) | ||
| 1002 | (xref--transient-buffer-mode) | 1006 | (xref--transient-buffer-mode) |
| 1003 | (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) | 1007 | (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) |
| 1004 | (pop-to-buffer (current-buffer) | 1008 | (pop-to-buffer (current-buffer) |
| @@ -1374,7 +1378,8 @@ IGNORES is a list of glob patterns for files to ignore." | |||
| 1374 | ;; do that reliably enough, without creating false negatives? | 1378 | ;; do that reliably enough, without creating false negatives? |
| 1375 | (command (xref--rgrep-command (xref--regexp-to-extended regexp) | 1379 | (command (xref--rgrep-command (xref--regexp-to-extended regexp) |
| 1376 | files | 1380 | files |
| 1377 | (file-local-name (expand-file-name dir)) | 1381 | (file-name-as-directory |
| 1382 | (file-local-name (expand-file-name dir))) | ||
| 1378 | ignores)) | 1383 | ignores)) |
| 1379 | (def default-directory) | 1384 | (def default-directory) |
| 1380 | (buf (get-buffer-create " *xref-grep*")) | 1385 | (buf (get-buffer-create " *xref-grep*")) |
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index f9842b52b13..378358feac2 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text | 1 | ;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text -*- lexical-binding: t; -*- |
| 2 | ;; | 2 | ;; |
| 3 | ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. |
| 4 | ;; | 4 | ;; |
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 802cb3072fa..eecdb60f3a4 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; scroll-bar.el --- window system-independent scroll bar support | 1 | ;;; scroll-bar.el --- window system-independent scroll bar support -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1993-1995, 1999-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1993-1995, 1999-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
diff --git a/lisp/startup.el b/lisp/startup.el index 30ce379a289..4b82f73da76 100644 --- a/lisp/startup.el +++ b/lisp/startup.el | |||
| @@ -1230,17 +1230,7 @@ please check its value") | |||
| 1230 | package-enable-at-startup | 1230 | package-enable-at-startup |
| 1231 | (not (bound-and-true-p package--activated)) | 1231 | (not (bound-and-true-p package--activated)) |
| 1232 | (catch 'package-dir-found | 1232 | (catch 'package-dir-found |
| 1233 | (let (dirs) | 1233 | (let ((dirs (cons package-user-dir package-directory-list))) |
| 1234 | (if (boundp 'package-directory-list) | ||
| 1235 | (setq dirs package-directory-list) | ||
| 1236 | (dolist (f load-path) | ||
| 1237 | (and (stringp f) | ||
| 1238 | (equal (file-name-nondirectory f) "site-lisp") | ||
| 1239 | (push (expand-file-name "elpa" f) dirs)))) | ||
| 1240 | (push (if (boundp 'package-user-dir) | ||
| 1241 | package-user-dir | ||
| 1242 | (locate-user-emacs-file "elpa")) | ||
| 1243 | dirs) | ||
| 1244 | (dolist (dir dirs) | 1234 | (dolist (dir dirs) |
| 1245 | (when (file-directory-p dir) | 1235 | (when (file-directory-p dir) |
| 1246 | (dolist (subdir (directory-files dir)) | 1236 | (dolist (subdir (directory-files dir)) |
diff --git a/lisp/subr.el b/lisp/subr.el index 1acc3c3250b..260202945b1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -995,6 +995,22 @@ a menu, so this function is not useful for non-menu keymaps." | |||
| 995 | (setq inserted t))) | 995 | (setq inserted t))) |
| 996 | (setq tail (cdr tail))))) | 996 | (setq tail (cdr tail))))) |
| 997 | 997 | ||
| 998 | (defun define-prefix-command (command &optional mapvar name) | ||
| 999 | "Define COMMAND as a prefix command. COMMAND should be a symbol. | ||
| 1000 | A new sparse keymap is stored as COMMAND's function definition and its | ||
| 1001 | value. | ||
| 1002 | This prepares COMMAND for use as a prefix key's binding. | ||
| 1003 | If a second optional argument MAPVAR is given, it should be a symbol. | ||
| 1004 | The map is then stored as MAPVAR's value instead of as COMMAND's | ||
| 1005 | value; but COMMAND is still defined as a function. | ||
| 1006 | The third optional argument NAME, if given, supplies a menu name | ||
| 1007 | string for the map. This is required to use the keymap as a menu. | ||
| 1008 | This function returns COMMAND." | ||
| 1009 | (let ((map (make-sparse-keymap name))) | ||
| 1010 | (fset command map) | ||
| 1011 | (set (or mapvar command) map) | ||
| 1012 | command)) | ||
| 1013 | |||
| 998 | (defun map-keymap-sorted (function keymap) | 1014 | (defun map-keymap-sorted (function keymap) |
| 999 | "Implement `map-keymap' with sorting. | 1015 | "Implement `map-keymap' with sorting. |
| 1000 | Don't call this function; it is for internal use only." | 1016 | Don't call this function; it is for internal use only." |
| @@ -1239,35 +1255,83 @@ in a cleaner way with command remapping, like this: | |||
| 1239 | 1255 | ||
| 1240 | ;;;; The global keymap tree. | 1256 | ;;;; The global keymap tree. |
| 1241 | 1257 | ||
| 1242 | ;; global-map, esc-map, and ctl-x-map have their values set up in | 1258 | (defvar esc-map |
| 1243 | ;; keymap.c; we just give them docstrings here. | 1259 | (let ((map (make-keymap))) |
| 1244 | 1260 | (define-key map "u" #'upcase-word) | |
| 1245 | (defvar global-map nil | 1261 | (define-key map "l" #'downcase-word) |
| 1246 | "Default global keymap mapping Emacs keyboard input into commands. | 1262 | (define-key map "c" #'capitalize-word) |
| 1247 | The value is a keymap that is usually (but not necessarily) Emacs's | 1263 | (define-key map "x" #'execute-extended-command) |
| 1248 | global map.") | 1264 | map) |
| 1249 | |||
| 1250 | (defvar esc-map nil | ||
| 1251 | "Default keymap for ESC (meta) commands. | 1265 | "Default keymap for ESC (meta) commands. |
| 1252 | The normal global definition of the character ESC indirects to this keymap.") | 1266 | The normal global definition of the character ESC indirects to this keymap.") |
| 1253 | 1267 | (fset 'ESC-prefix esc-map) | |
| 1254 | (defvar ctl-x-map nil | 1268 | (make-obsolete 'ESC-prefix 'esc-map "28.1") |
| 1255 | "Default keymap for C-x commands. | ||
| 1256 | The normal global definition of the character C-x indirects to this keymap.") | ||
| 1257 | 1269 | ||
| 1258 | (defvar ctl-x-4-map (make-sparse-keymap) | 1270 | (defvar ctl-x-4-map (make-sparse-keymap) |
| 1259 | "Keymap for subcommands of C-x 4.") | 1271 | "Keymap for subcommands of C-x 4.") |
| 1260 | (defalias 'ctl-x-4-prefix ctl-x-4-map) | 1272 | (defalias 'ctl-x-4-prefix ctl-x-4-map) |
| 1261 | (define-key ctl-x-map "4" 'ctl-x-4-prefix) | ||
| 1262 | 1273 | ||
| 1263 | (defvar ctl-x-5-map (make-sparse-keymap) | 1274 | (defvar ctl-x-5-map (make-sparse-keymap) |
| 1264 | "Keymap for frame commands.") | 1275 | "Keymap for frame commands.") |
| 1265 | (defalias 'ctl-x-5-prefix ctl-x-5-map) | 1276 | (defalias 'ctl-x-5-prefix ctl-x-5-map) |
| 1266 | (define-key ctl-x-map "5" 'ctl-x-5-prefix) | ||
| 1267 | 1277 | ||
| 1268 | (defvar tab-prefix-map (make-sparse-keymap) | 1278 | (defvar tab-prefix-map (make-sparse-keymap) |
| 1269 | "Keymap for tab-bar related commands.") | 1279 | "Keymap for tab-bar related commands.") |
| 1270 | (define-key ctl-x-map "t" tab-prefix-map) | 1280 | |
| 1281 | (defvar ctl-x-map | ||
| 1282 | (let ((map (make-keymap))) | ||
| 1283 | (define-key map "4" 'ctl-x-4-prefix) | ||
| 1284 | (define-key map "5" 'ctl-x-5-prefix) | ||
| 1285 | (define-key map "t" tab-prefix-map) | ||
| 1286 | |||
| 1287 | (define-key map "b" #'switch-to-buffer) | ||
| 1288 | (define-key map "k" #'kill-buffer) | ||
| 1289 | (define-key map "\C-u" #'upcase-region) (put 'upcase-region 'disabled t) | ||
| 1290 | (define-key map "\C-l" #'downcase-region) (put 'downcase-region 'disabled t) | ||
| 1291 | (define-key map "<" #'scroll-left) | ||
| 1292 | (define-key map ">" #'scroll-right) | ||
| 1293 | map) | ||
| 1294 | "Default keymap for C-x commands. | ||
| 1295 | The normal global definition of the character C-x indirects to this keymap.") | ||
| 1296 | (fset 'Control-X-prefix ctl-x-map) | ||
| 1297 | (make-obsolete 'Control-X-prefix 'ctl-x-map "28.1") | ||
| 1298 | |||
| 1299 | (defvar global-map | ||
| 1300 | (let ((map (make-keymap))) | ||
| 1301 | (define-key map "\C-[" 'ESC-prefix) | ||
| 1302 | (define-key map "\C-x" 'Control-X-prefix) | ||
| 1303 | |||
| 1304 | (define-key map "\C-i" #'self-insert-command) | ||
| 1305 | (let* ((vec1 (make-vector 1 nil)) | ||
| 1306 | (f (lambda (from to) | ||
| 1307 | (while (< from to) | ||
| 1308 | (aset vec1 0 from) | ||
| 1309 | (define-key map vec1 #'self-insert-command) | ||
| 1310 | (setq from (1+ from)))))) | ||
| 1311 | (funcall f #o040 #o0177) | ||
| 1312 | (when (eq system-type 'ms-dos) ;FIXME: Why? | ||
| 1313 | (funcall f #o0200 #o0240)) | ||
| 1314 | (funcall f #o0240 #o0400)) | ||
| 1315 | |||
| 1316 | (define-key map "\C-a" #'beginning-of-line) | ||
| 1317 | (define-key map "\C-b" #'backward-char) | ||
| 1318 | (define-key map "\C-e" #'end-of-line) | ||
| 1319 | (define-key map "\C-f" #'forward-char) | ||
| 1320 | |||
| 1321 | (define-key map "\C-z" #'suspend-emacs) ;FIXME: Re-bound later! | ||
| 1322 | (define-key map "\C-x\C-z" #'suspend-emacs) ;FIXME: Re-bound later! | ||
| 1323 | |||
| 1324 | (define-key map "\C-v" #'scroll-up-command) | ||
| 1325 | (define-key map "\M-v" #'scroll-down-command) | ||
| 1326 | (define-key map "\M-\C-v" #'scroll-other-window) | ||
| 1327 | |||
| 1328 | (define-key map "\M-\C-c" #'exit-recursive-edit) | ||
| 1329 | (define-key map "\C-]" #'abort-recursive-edit) | ||
| 1330 | map) | ||
| 1331 | "Default global keymap mapping Emacs keyboard input into commands. | ||
| 1332 | The value is a keymap that is usually (but not necessarily) Emacs's | ||
| 1333 | global map.") | ||
| 1334 | (use-global-map global-map) | ||
| 1271 | 1335 | ||
| 1272 | 1336 | ||
| 1273 | ;;;; Event manipulation functions. | 1337 | ;;;; Event manipulation functions. |
| @@ -1749,7 +1813,11 @@ unless HOOK has both local and global functions). If multiple | |||
| 1749 | functions have the same representation under `princ', the first | 1813 | functions have the same representation under `princ', the first |
| 1750 | one will be removed." | 1814 | one will be removed." |
| 1751 | (interactive | 1815 | (interactive |
| 1752 | (let* ((hook (intern (completing-read "Hook variable: " obarray #'boundp t))) | 1816 | (let* ((default (and (symbolp (variable-at-point)) |
| 1817 | (symbol-name (variable-at-point)))) | ||
| 1818 | (hook (intern (completing-read | ||
| 1819 | (format-prompt "Hook variable" default) | ||
| 1820 | obarray #'boundp t nil nil default))) | ||
| 1753 | (local | 1821 | (local |
| 1754 | (and | 1822 | (and |
| 1755 | (local-variable-p hook) | 1823 | (local-variable-p hook) |
| @@ -1806,9 +1874,33 @@ all symbols are bound before any of the VALUEFORMs are evalled." | |||
| 1806 | ;; As a special-form, we could implement it more efficiently (and cleanly, | 1874 | ;; As a special-form, we could implement it more efficiently (and cleanly, |
| 1807 | ;; making the vars actually unbound during evaluation of the binders). | 1875 | ;; making the vars actually unbound during evaluation of the binders). |
| 1808 | (declare (debug let) (indent 1)) | 1876 | (declare (debug let) (indent 1)) |
| 1809 | `(let ,(mapcar #'car binders) | 1877 | ;; Use plain `let*' for the non-recursive definitions. |
| 1810 | ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) | 1878 | ;; This only handles the case where the first few definitions are not |
| 1811 | ,@body)) | 1879 | ;; recursive. Nothing as fancy as an SCC analysis. |
| 1880 | (let ((seqbinds nil)) | ||
| 1881 | ;; Our args haven't yet been macro-expanded, so `macroexp--fgrep' | ||
| 1882 | ;; may fail to see references that will be introduced later by | ||
| 1883 | ;; macroexpansion. We could call `macroexpand-all' to avoid that, | ||
| 1884 | ;; but in order to avoid that, we instead check to see if the binders | ||
| 1885 | ;; appear in the macroexp environment, since that's how references can be | ||
| 1886 | ;; introduced later on. | ||
| 1887 | (unless (macroexp--fgrep binders macroexpand-all-environment) | ||
| 1888 | (while (and binders | ||
| 1889 | (null (macroexp--fgrep binders (nth 1 (car binders))))) | ||
| 1890 | (push (pop binders) seqbinds))) | ||
| 1891 | (let ((nbody (if (null binders) | ||
| 1892 | (macroexp-progn body) | ||
| 1893 | `(let ,(mapcar #'car binders) | ||
| 1894 | ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) | ||
| 1895 | ,@body)))) | ||
| 1896 | (cond | ||
| 1897 | ;; All bindings are recursive. | ||
| 1898 | ((null seqbinds) nbody) | ||
| 1899 | ;; Special case for trivial uses. | ||
| 1900 | ((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds))) | ||
| 1901 | (nth 1 (car seqbinds))) | ||
| 1902 | ;; General case. | ||
| 1903 | (t `(let* ,(nreverse seqbinds) ,nbody)))))) | ||
| 1812 | 1904 | ||
| 1813 | (defmacro dlet (binders &rest body) | 1905 | (defmacro dlet (binders &rest body) |
| 1814 | "Like `let*' but using dynamic scoping." | 1906 | "Like `let*' but using dynamic scoping." |
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 935c97e2a41..7e556550daa 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el | |||
| @@ -95,23 +95,26 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and | |||
| 95 | :version "27.1") | 95 | :version "27.1") |
| 96 | 96 | ||
| 97 | 97 | ||
| 98 | (define-minor-mode tab-bar-mode | 98 | (defun tab-bar--define-keys () |
| 99 | "Toggle the tab bar in all graphical frames (Tab Bar mode)." | 99 | "Install key bindings for switching between tabs if the user has configured them." |
| 100 | :global t | 100 | (when tab-bar-select-tab-modifiers |
| 101 | ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. | 101 | (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0))) |
| 102 | :variable tab-bar-mode | 102 | 'tab-bar-switch-to-recent-tab) |
| 103 | (let ((val (if tab-bar-mode 1 0))) | 103 | (dotimes (i 9) |
| 104 | (dolist (frame (frame-list)) | 104 | (global-set-key (vector (append tab-bar-select-tab-modifiers |
| 105 | (set-frame-parameter frame 'tab-bar-lines val)) | 105 | (list (+ i 1 ?0)))) |
| 106 | ;; If the user has given `default-frame-alist' a `tab-bar-lines' | 106 | 'tab-bar-select-tab))) |
| 107 | ;; parameter, replace it. | 107 | ;; Don't override user customized key bindings |
| 108 | (if (assq 'tab-bar-lines default-frame-alist) | 108 | (unless (global-key-binding [(control tab)]) |
| 109 | (setq default-frame-alist | 109 | (global-set-key [(control tab)] 'tab-next)) |
| 110 | (cons (cons 'tab-bar-lines val) | 110 | (unless (global-key-binding [(control shift tab)]) |
| 111 | (assq-delete-all 'tab-bar-lines | 111 | (global-set-key [(control shift tab)] 'tab-previous)) |
| 112 | default-frame-alist))))) | 112 | (unless (global-key-binding [(control shift iso-lefttab)]) |
| 113 | 113 | (global-set-key [(control shift iso-lefttab)] 'tab-previous))) | |
| 114 | (when (and tab-bar-mode tab-bar-new-button | 114 | |
| 115 | (defun tab-bar--load-buttons () | ||
| 116 | "Load the icons for the tab buttons." | ||
| 117 | (when (and tab-bar-new-button | ||
| 115 | (not (get-text-property 0 'display tab-bar-new-button))) | 118 | (not (get-text-property 0 'display tab-bar-new-button))) |
| 116 | ;; This file is pre-loaded so only here we can use the right data-directory: | 119 | ;; This file is pre-loaded so only here we can use the right data-directory: |
| 117 | (add-text-properties 0 (length tab-bar-new-button) | 120 | (add-text-properties 0 (length tab-bar-new-button) |
| @@ -121,7 +124,7 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and | |||
| 121 | :ascent center)) | 124 | :ascent center)) |
| 122 | tab-bar-new-button)) | 125 | tab-bar-new-button)) |
| 123 | 126 | ||
| 124 | (when (and tab-bar-mode tab-bar-close-button | 127 | (when (and tab-bar-close-button |
| 125 | (not (get-text-property 0 'display tab-bar-close-button))) | 128 | (not (get-text-property 0 'display tab-bar-close-button))) |
| 126 | ;; This file is pre-loaded so only here we can use the right data-directory: | 129 | ;; This file is pre-loaded so only here we can use the right data-directory: |
| 127 | (add-text-properties 0 (length tab-bar-close-button) | 130 | (add-text-properties 0 (length tab-bar-close-button) |
| @@ -129,24 +132,27 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and | |||
| 129 | :file "tabs/close.xpm" | 132 | :file "tabs/close.xpm" |
| 130 | :margin (2 . 0) | 133 | :margin (2 . 0) |
| 131 | :ascent center)) | 134 | :ascent center)) |
| 132 | tab-bar-close-button)) | 135 | tab-bar-close-button))) |
| 133 | 136 | ||
| 137 | (define-minor-mode tab-bar-mode | ||
| 138 | "Toggle the tab bar in all graphical frames (Tab Bar mode)." | ||
| 139 | :global t | ||
| 140 | ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. | ||
| 141 | :variable tab-bar-mode | ||
| 142 | (let ((val (if tab-bar-mode 1 0))) | ||
| 143 | (dolist (frame (frame-list)) | ||
| 144 | (set-frame-parameter frame 'tab-bar-lines val)) | ||
| 145 | ;; If the user has given `default-frame-alist' a `tab-bar-lines' | ||
| 146 | ;; parameter, replace it. | ||
| 147 | (if (assq 'tab-bar-lines default-frame-alist) | ||
| 148 | (setq default-frame-alist | ||
| 149 | (cons (cons 'tab-bar-lines val) | ||
| 150 | (assq-delete-all 'tab-bar-lines | ||
| 151 | default-frame-alist))))) | ||
| 152 | (when tab-bar-mode | ||
| 153 | (tab-bar--load-buttons)) | ||
| 134 | (if tab-bar-mode | 154 | (if tab-bar-mode |
| 135 | (progn | 155 | (tab-bar--define-keys) |
| 136 | (when tab-bar-select-tab-modifiers | ||
| 137 | (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0))) | ||
| 138 | 'tab-bar-switch-to-recent-tab) | ||
| 139 | (dotimes (i 9) | ||
| 140 | (global-set-key (vector (append tab-bar-select-tab-modifiers | ||
| 141 | (list (+ i 1 ?0)))) | ||
| 142 | 'tab-bar-select-tab))) | ||
| 143 | ;; Don't override user customized key bindings | ||
| 144 | (unless (global-key-binding [(control tab)]) | ||
| 145 | (global-set-key [(control tab)] 'tab-next)) | ||
| 146 | (unless (global-key-binding [(control shift tab)]) | ||
| 147 | (global-set-key [(control shift tab)] 'tab-previous)) | ||
| 148 | (unless (global-key-binding [(control shift iso-lefttab)]) | ||
| 149 | (global-set-key [(control shift iso-lefttab)] 'tab-previous))) | ||
| 150 | ;; Unset only keys bound by tab-bar | 156 | ;; Unset only keys bound by tab-bar |
| 151 | (when (eq (global-key-binding [(control tab)]) 'tab-next) | 157 | (when (eq (global-key-binding [(control tab)]) 'tab-next) |
| 152 | (global-unset-key [(control tab)])) | 158 | (global-unset-key [(control tab)])) |
| @@ -181,15 +187,27 @@ on a console which has no window system but does have a mouse." | |||
| 181 | ;; Clicking anywhere outside existing tabs will add a new tab | 187 | ;; Clicking anywhere outside existing tabs will add a new tab |
| 182 | (tab-bar-new-tab))))) | 188 | (tab-bar-new-tab))))) |
| 183 | 189 | ||
| 184 | ;; Used in the Show/Hide menu, to have the toggle reflect the current frame. | ||
| 185 | (defun toggle-tab-bar-mode-from-frame (&optional arg) | 190 | (defun toggle-tab-bar-mode-from-frame (&optional arg) |
| 186 | "Toggle tab bar on or off, based on the status of the current frame. | 191 | "Toggle tab bar on or off, based on the status of the current frame. |
| 192 | Used in the Show/Hide menu, to have the toggle reflect the current frame. | ||
| 187 | See `tab-bar-mode' for more information." | 193 | See `tab-bar-mode' for more information." |
| 188 | (interactive (list (or current-prefix-arg 'toggle))) | 194 | (interactive (list (or current-prefix-arg 'toggle))) |
| 189 | (if (eq arg 'toggle) | 195 | (if (eq arg 'toggle) |
| 190 | (tab-bar-mode (if (> (frame-parameter nil 'tab-bar-lines) 0) 0 1)) | 196 | (tab-bar-mode (if (> (frame-parameter nil 'tab-bar-lines) 0) 0 1)) |
| 191 | (tab-bar-mode arg))) | 197 | (tab-bar-mode arg))) |
| 192 | 198 | ||
| 199 | (defun toggle-frame-tab-bar (&optional frame) | ||
| 200 | "Toggle tab bar of FRAME. | ||
| 201 | This is useful when you want to enable the tab bar individually | ||
| 202 | on each new frame when the global `tab-bar-mode' is disabled, | ||
| 203 | or when you want to disable the tab bar individually on each | ||
| 204 | new frame when the global `tab-bar-mode' is enabled, by using | ||
| 205 | |||
| 206 | (add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)" | ||
| 207 | (interactive) | ||
| 208 | (set-frame-parameter frame 'tab-bar-lines | ||
| 209 | (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1))) | ||
| 210 | |||
| 193 | (defvar tab-bar-map (make-sparse-keymap) | 211 | (defvar tab-bar-map (make-sparse-keymap) |
| 194 | "Keymap for the tab bar. | 212 | "Keymap for the tab bar. |
| 195 | Define this locally to override the global tab bar.") | 213 | Define this locally to override the global tab bar.") |
| @@ -218,18 +236,31 @@ If the value is `1', then hide the tab bar when it has only one tab, | |||
| 218 | and show it again once more tabs are created. | 236 | and show it again once more tabs are created. |
| 219 | If nil, always keep the tab bar hidden. In this case it's still | 237 | If nil, always keep the tab bar hidden. In this case it's still |
| 220 | possible to use persistent named window configurations by relying on | 238 | possible to use persistent named window configurations by relying on |
| 221 | keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc." | 239 | keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc. |
| 240 | |||
| 241 | Setting this variable directly does not take effect; please customize | ||
| 242 | it (see the info node `Easy Customization'), then it will automatically | ||
| 243 | update the tab bar on all frames according to the new value. | ||
| 244 | |||
| 245 | To enable or disable the tab bar individually on each frame, | ||
| 246 | you can use the command `toggle-frame-tab-bar'." | ||
| 222 | :type '(choice (const :tag "Always" t) | 247 | :type '(choice (const :tag "Always" t) |
| 223 | (const :tag "When more than one tab" 1) | 248 | (const :tag "When more than one tab" 1) |
| 224 | (const :tag "Never" nil)) | 249 | (const :tag "Never" nil)) |
| 225 | :initialize 'custom-initialize-default | 250 | :initialize 'custom-initialize-default |
| 226 | :set (lambda (sym val) | 251 | :set (lambda (sym val) |
| 227 | (set-default sym val) | 252 | (set-default sym val) |
| 228 | (tab-bar-mode | 253 | ;; Preload button images |
| 229 | (if (or (eq val t) | 254 | (tab-bar-mode 1) |
| 230 | (and (natnump val) | 255 | ;; Then handle each frame individually |
| 231 | (> (length (funcall tab-bar-tabs-function)) val))) | 256 | (dolist (frame (frame-list)) |
| 232 | 1 -1))) | 257 | (set-frame-parameter |
| 258 | frame 'tab-bar-lines | ||
| 259 | (if (or (eq val t) | ||
| 260 | (and (natnump val) | ||
| 261 | (> (length (funcall tab-bar-tabs-function frame)) | ||
| 262 | val))) | ||
| 263 | 1 0)))) | ||
| 233 | :group 'tab-bar | 264 | :group 'tab-bar |
| 234 | :version "27.1") | 265 | :version "27.1") |
| 235 | 266 | ||
| @@ -418,6 +449,30 @@ Return its existing value or a new value." | |||
| 418 | tabs)) | 449 | tabs)) |
| 419 | 450 | ||
| 420 | 451 | ||
| 452 | (defcustom tab-bar-tab-name-format-function #'tab-bar-tab-name-format-default | ||
| 453 | "Function to format a tab name. | ||
| 454 | Function gets two arguments, the tab and its number, and should return | ||
| 455 | the formatted tab name to display in the tab bar." | ||
| 456 | :type 'function | ||
| 457 | :initialize 'custom-initialize-default | ||
| 458 | :set (lambda (sym val) | ||
| 459 | (set-default sym val) | ||
| 460 | (force-mode-line-update)) | ||
| 461 | :group 'tab-bar | ||
| 462 | :version "28.1") | ||
| 463 | |||
| 464 | (defun tab-bar-tab-name-format-default (tab i) | ||
| 465 | (let ((current-p (eq (car tab) 'current-tab))) | ||
| 466 | (propertize | ||
| 467 | (concat (if tab-bar-tab-hints (format "%d " i) "") | ||
| 468 | (alist-get 'name tab) | ||
| 469 | (or (and tab-bar-close-button-show | ||
| 470 | (not (eq tab-bar-close-button-show | ||
| 471 | (if current-p 'non-selected 'selected))) | ||
| 472 | tab-bar-close-button) | ||
| 473 | "")) | ||
| 474 | 'face (if current-p 'tab-bar-tab 'tab-bar-tab-inactive)))) | ||
| 475 | |||
| 421 | (defun tab-bar-make-keymap-1 () | 476 | (defun tab-bar-make-keymap-1 () |
| 422 | "Generate an actual keymap from `tab-bar-map', without caching." | 477 | "Generate an actual keymap from `tab-bar-map', without caching." |
| 423 | (let* ((separator (or tab-bar-separator (if window-system " " "|"))) | 478 | (let* ((separator (or tab-bar-separator (if window-system " " "|"))) |
| @@ -443,25 +498,13 @@ Return its existing value or a new value." | |||
| 443 | ((eq (car tab) 'current-tab) | 498 | ((eq (car tab) 'current-tab) |
| 444 | `((current-tab | 499 | `((current-tab |
| 445 | menu-item | 500 | menu-item |
| 446 | ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "") | 501 | ,(funcall tab-bar-tab-name-format-function tab i) |
| 447 | (alist-get 'name tab) | ||
| 448 | (or (and tab-bar-close-button-show | ||
| 449 | (not (eq tab-bar-close-button-show | ||
| 450 | 'non-selected)) | ||
| 451 | tab-bar-close-button) "")) | ||
| 452 | 'face 'tab-bar-tab) | ||
| 453 | ignore | 502 | ignore |
| 454 | :help "Current tab"))) | 503 | :help "Current tab"))) |
| 455 | (t | 504 | (t |
| 456 | `((,(intern (format "tab-%i" i)) | 505 | `((,(intern (format "tab-%i" i)) |
| 457 | menu-item | 506 | menu-item |
| 458 | ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "") | 507 | ,(funcall tab-bar-tab-name-format-function tab i) |
| 459 | (alist-get 'name tab) | ||
| 460 | (or (and tab-bar-close-button-show | ||
| 461 | (not (eq tab-bar-close-button-show | ||
| 462 | 'selected)) | ||
| 463 | tab-bar-close-button) "")) | ||
| 464 | 'face 'tab-bar-tab-inactive) | ||
| 465 | ,(or | 508 | ,(or |
| 466 | (alist-get 'binding tab) | 509 | (alist-get 'binding tab) |
| 467 | `(lambda () | 510 | `(lambda () |
| @@ -815,7 +858,10 @@ After the tab is created, the hooks in | |||
| 815 | ((and (natnump tab-bar-show) | 858 | ((and (natnump tab-bar-show) |
| 816 | (> (length (funcall tab-bar-tabs-function)) tab-bar-show) | 859 | (> (length (funcall tab-bar-tabs-function)) tab-bar-show) |
| 817 | (zerop (frame-parameter nil 'tab-bar-lines))) | 860 | (zerop (frame-parameter nil 'tab-bar-lines))) |
| 818 | (set-frame-parameter nil 'tab-bar-lines 1))) | 861 | (progn |
| 862 | (tab-bar--load-buttons) | ||
| 863 | (tab-bar--define-keys) | ||
| 864 | (set-frame-parameter nil 'tab-bar-lines 1)))) | ||
| 819 | 865 | ||
| 820 | (force-mode-line-update) | 866 | (force-mode-line-update) |
| 821 | (unless tab-bar-mode | 867 | (unless tab-bar-mode |
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index 8d5cb191dd8..8ae58718e3f 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; common-win.el --- common part of handling window systems | 1 | ;;; common-win.el --- common part of handling window systems -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index 1aeaffbbc01..740d0654a17 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; tty-colors.el --- color support for character terminals | 1 | ;;; tty-colors.el --- color support for character terminals -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index e9bef6ec801..3346c551d93 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; fill.el --- fill commands for Emacs | 1 | ;;; fill.el --- fill commands for Emacs -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2021 Free | 3 | ;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2021 Free |
| 4 | ;; Software Foundation, Inc. | 4 | ;; Software Foundation, Inc. |
| @@ -40,13 +40,11 @@ Non-nil means changing indent doesn't end a paragraph. | |||
| 40 | That mode can handle paragraphs with extra indentation on the first line, | 40 | That mode can handle paragraphs with extra indentation on the first line, |
| 41 | but it requires separator lines between paragraphs. | 41 | but it requires separator lines between paragraphs. |
| 42 | A value of nil means that any change in indentation starts a new paragraph." | 42 | A value of nil means that any change in indentation starts a new paragraph." |
| 43 | :type 'boolean | 43 | :type 'boolean) |
| 44 | :group 'fill) | ||
| 45 | 44 | ||
| 46 | (defcustom colon-double-space nil | 45 | (defcustom colon-double-space nil |
| 47 | "Non-nil means put two spaces after a colon when filling." | 46 | "Non-nil means put two spaces after a colon when filling." |
| 48 | :type 'boolean | 47 | :type 'boolean) |
| 49 | :group 'fill) | ||
| 50 | (put 'colon-double-space 'safe-local-variable 'booleanp) | 48 | (put 'colon-double-space 'safe-local-variable 'booleanp) |
| 51 | 49 | ||
| 52 | (defcustom fill-separate-heterogeneous-words-with-space nil | 50 | (defcustom fill-separate-heterogeneous-words-with-space nil |
| @@ -56,7 +54,6 @@ the beginning of the next line when concatenating them for | |||
| 56 | filling those lines. Whether to use a space depends on how the | 54 | filling those lines. Whether to use a space depends on how the |
| 57 | words are categorized." | 55 | words are categorized." |
| 58 | :type 'boolean | 56 | :type 'boolean |
| 59 | :group 'fill | ||
| 60 | :version "26.1") | 57 | :version "26.1") |
| 61 | 58 | ||
| 62 | (defvar fill-paragraph-function nil | 59 | (defvar fill-paragraph-function nil |
| @@ -75,8 +72,7 @@ such as `fill-forward-paragraph-function'.") | |||
| 75 | Kinsoku processing is designed to prevent certain characters from being | 72 | Kinsoku processing is designed to prevent certain characters from being |
| 76 | placed at the beginning or end of a line by filling. | 73 | placed at the beginning or end of a line by filling. |
| 77 | See the documentation of `kinsoku' for more information." | 74 | See the documentation of `kinsoku' for more information." |
| 78 | :type 'boolean | 75 | :type 'boolean) |
| 79 | :group 'fill) | ||
| 80 | 76 | ||
| 81 | (defun set-fill-prefix () | 77 | (defun set-fill-prefix () |
| 82 | "Set the fill prefix to the current line up to point. | 78 | "Set the fill prefix to the current line up to point. |
| @@ -96,8 +92,7 @@ reinserts the fill prefix in each resulting line." | |||
| 96 | 92 | ||
| 97 | (defcustom adaptive-fill-mode t | 93 | (defcustom adaptive-fill-mode t |
| 98 | "Non-nil means determine a paragraph's fill prefix from its text." | 94 | "Non-nil means determine a paragraph's fill prefix from its text." |
| 99 | :type 'boolean | 95 | :type 'boolean) |
| 100 | :group 'fill) | ||
| 101 | 96 | ||
| 102 | (defcustom adaptive-fill-regexp | 97 | (defcustom adaptive-fill-regexp |
| 103 | ;; Added `!' for doxygen comments starting with `//!' or `/*!'. | 98 | ;; Added `!' for doxygen comments starting with `//!' or `/*!'. |
| @@ -113,8 +108,7 @@ standard indentation for the whole paragraph. | |||
| 113 | If the paragraph has just one line, the indentation is taken from that | 108 | If the paragraph has just one line, the indentation is taken from that |
| 114 | line, but in that case `adaptive-fill-first-line-regexp' also plays | 109 | line, but in that case `adaptive-fill-first-line-regexp' also plays |
| 115 | a role." | 110 | a role." |
| 116 | :type 'regexp | 111 | :type 'regexp) |
| 117 | :group 'fill) | ||
| 118 | 112 | ||
| 119 | (defcustom adaptive-fill-first-line-regexp (purecopy "\\`[ \t]*\\'") | 113 | (defcustom adaptive-fill-first-line-regexp (purecopy "\\`[ \t]*\\'") |
| 120 | "Regexp specifying whether to set fill prefix from a one-line paragraph. | 114 | "Regexp specifying whether to set fill prefix from a one-line paragraph. |
| @@ -126,15 +120,13 @@ By default, this regexp matches sequences of just spaces and tabs. | |||
| 126 | 120 | ||
| 127 | However, we never use a prefix from a one-line paragraph | 121 | However, we never use a prefix from a one-line paragraph |
| 128 | if it would act as a paragraph-starter on the second line." | 122 | if it would act as a paragraph-starter on the second line." |
| 129 | :type 'regexp | 123 | :type 'regexp) |
| 130 | :group 'fill) | ||
| 131 | 124 | ||
| 132 | (defcustom adaptive-fill-function #'ignore | 125 | (defcustom adaptive-fill-function #'ignore |
| 133 | "Function to call to choose a fill prefix for a paragraph. | 126 | "Function to call to choose a fill prefix for a paragraph. |
| 134 | A nil return value means the function has not determined the fill prefix." | 127 | A nil return value means the function has not determined the fill prefix." |
| 135 | :version "27.1" | 128 | :version "27.1" |
| 136 | :type 'function | 129 | :type 'function) |
| 137 | :group 'fill) | ||
| 138 | 130 | ||
| 139 | (defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks. | 131 | (defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks. |
| 140 | "Whether or not filling should try to use the major mode's indentation.") | 132 | "Whether or not filling should try to use the major mode's indentation.") |
| @@ -367,15 +359,13 @@ which is an error according to some typographical conventions." | |||
| 367 | The predicates are called with no arguments, with point at the place to | 359 | The predicates are called with no arguments, with point at the place to |
| 368 | be tested. If it returns a non-nil value, fill commands do not break | 360 | be tested. If it returns a non-nil value, fill commands do not break |
| 369 | the line there." | 361 | the line there." |
| 370 | :group 'fill | ||
| 371 | :type 'hook | 362 | :type 'hook |
| 372 | :options '(fill-french-nobreak-p fill-single-word-nobreak-p | 363 | :options '(fill-french-nobreak-p fill-single-word-nobreak-p |
| 373 | fill-single-char-nobreak-p)) | 364 | fill-single-char-nobreak-p)) |
| 374 | 365 | ||
| 375 | (defcustom fill-nobreak-invisible nil | 366 | (defcustom fill-nobreak-invisible nil |
| 376 | "Non-nil means that fill commands do not break lines in invisible text." | 367 | "Non-nil means that fill commands do not break lines in invisible text." |
| 377 | :type 'boolean | 368 | :type 'boolean) |
| 378 | :group 'fill) | ||
| 379 | 369 | ||
| 380 | (defun fill-nobreak-p () | 370 | (defun fill-nobreak-p () |
| 381 | "Return nil if breaking the line at point is allowed. | 371 | "Return nil if breaking the line at point is allowed. |
| @@ -1110,8 +1100,7 @@ The `justification' text-property can locally override this variable." | |||
| 1110 | (const full) | 1100 | (const full) |
| 1111 | (const center) | 1101 | (const center) |
| 1112 | (const none)) | 1102 | (const none)) |
| 1113 | :safe 'symbolp | 1103 | :safe 'symbolp) |
| 1114 | :group 'fill) | ||
| 1115 | (make-variable-buffer-local 'default-justification) | 1104 | (make-variable-buffer-local 'default-justification) |
| 1116 | 1105 | ||
| 1117 | (defun current-justification () | 1106 | (defun current-justification () |
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 217ae10fe4d..96edfd6de36 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el | |||
| @@ -371,50 +371,33 @@ See `forward-paragraph' for more information." | |||
| 371 | 371 | ||
| 372 | (defun mark-paragraph (&optional arg allow-extend) | 372 | (defun mark-paragraph (&optional arg allow-extend) |
| 373 | "Put point at beginning of this paragraph, mark at end. | 373 | "Put point at beginning of this paragraph, mark at end. |
| 374 | The paragraph marked is the one that contains point or follows | 374 | The paragraph marked is the one that contains point or follows point. |
| 375 | point. | ||
| 376 | 375 | ||
| 377 | With argument ARG, puts mark at the end of this or a following | 376 | With argument ARG, puts mark at end of a following paragraph, so that |
| 378 | paragraph, so that the number of paragraphs marked equals ARG. | 377 | the number of paragraphs marked equals ARG. |
| 379 | 378 | ||
| 380 | If ARG is negative, point is put at the end of this paragraph, | 379 | If ARG is negative, point is put at end of this paragraph, mark is put |
| 381 | mark is put at the beginning of this or a previous paragraph. | 380 | at beginning of this or a previous paragraph. |
| 382 | 381 | ||
| 383 | Interactively (or if ALLOW-EXTEND is non-nil), if this command is | 382 | Interactively (or if ALLOW-EXTEND is non-nil), if this command is |
| 384 | repeated or (in Transient Mark mode) if the mark is active, it | 383 | repeated or (in Transient Mark mode) if the mark is active, |
| 385 | marks the next ARG paragraphs after the region already marked. | 384 | it marks the next ARG paragraphs after the ones already marked." |
| 386 | This also means when activating the mark immediately before using | 385 | (interactive "p\np") |
| 387 | this command, the current paragraph is only marked from point." | 386 | (unless arg (setq arg 1)) |
| 388 | (interactive "P\np") | 387 | (when (zerop arg) |
| 389 | (let ((numeric-arg (prefix-numeric-value arg))) | 388 | (error "Cannot mark zero paragraphs")) |
| 390 | (cond ((zerop numeric-arg)) | 389 | (cond ((and allow-extend |
| 391 | ((and allow-extend | 390 | (or (and (eq last-command this-command) (mark t)) |
| 392 | (or (and (eq last-command this-command) mark-active) | 391 | (and transient-mark-mode mark-active))) |
| 393 | (region-active-p))) | 392 | (set-mark |
| 394 | (if arg | 393 | (save-excursion |
| 395 | (setq arg numeric-arg) | 394 | (goto-char (mark)) |
| 396 | (if (< (mark) (point)) | 395 | (forward-paragraph arg) |
| 397 | (setq arg -1) | 396 | (point)))) |
| 398 | (setq arg 1))) | 397 | (t |
| 399 | (set-mark | 398 | (forward-paragraph arg) |
| 400 | (save-excursion | 399 | (push-mark nil t t) |
| 401 | (goto-char (mark)) | 400 | (backward-paragraph arg)))) |
| 402 | (forward-paragraph arg) | ||
| 403 | (point)))) | ||
| 404 | ;; don't activate the mark when at eob | ||
| 405 | ((and (eobp) (> numeric-arg 0))) | ||
| 406 | (t | ||
| 407 | (unless (save-excursion | ||
| 408 | (forward-line 0) | ||
| 409 | (looking-at paragraph-start)) | ||
| 410 | (backward-paragraph (cond ((> numeric-arg 0) 1) | ||
| 411 | ((< numeric-arg 0) -1) | ||
| 412 | (t 0)))) | ||
| 413 | (push-mark | ||
| 414 | (save-excursion | ||
| 415 | (forward-paragraph numeric-arg) | ||
| 416 | (point)) | ||
| 417 | t t))))) | ||
| 418 | 401 | ||
| 419 | (defun kill-paragraph (arg) | 402 | (defun kill-paragraph (arg) |
| 420 | "Kill forward to end of paragraph. | 403 | "Kill forward to end of paragraph. |
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 073059d52e8..d4c1b87262e 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el | |||
| @@ -906,7 +906,8 @@ DOWNCASE t: Downcase words before using them." | |||
| 906 | ;; begin, optional spaces and opening brace | 906 | ;; begin, optional spaces and opening brace |
| 907 | "begin[[:space:]]*{" | 907 | "begin[[:space:]]*{" |
| 908 | ;; Build a regexp for env names | 908 | ;; Build a regexp for env names |
| 909 | (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" "darray")) | 909 | (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" |
| 910 | "darray" "frame")) | ||
| 910 | ;; closing brace, optional spaces | 911 | ;; closing brace, optional spaces |
| 911 | "}[[:space:]]*" | 912 | "}[[:space:]]*" |
| 912 | ;; Now for macros | 913 | ;; Now for macros |
| @@ -919,9 +920,9 @@ DOWNCASE t: Downcase words before using them." | |||
| 919 | "\\[[^][]*" | 920 | "\\[[^][]*" |
| 920 | ;; Allow nested levels of chars enclosed in braces | 921 | ;; Allow nested levels of chars enclosed in braces |
| 921 | "\\(?:{[^}{]*" | 922 | "\\(?:{[^}{]*" |
| 922 | "\\(?:{[^}{]*" | 923 | "\\(?:{[^}{]*" |
| 923 | "\\(?:{[^}{]*}[^}{]*\\)*" | 924 | "\\(?:{[^}{]*}[^}{]*\\)*" |
| 924 | "}[^}{]*\\)*" | 925 | "}[^}{]*\\)*" |
| 925 | "}[^][]*\\)*" | 926 | "}[^][]*\\)*" |
| 926 | ;; Match the label key | 927 | ;; Match the label key |
| 927 | "\\<label[[:space:]]*=[[:space:]]*" | 928 | "\\<label[[:space:]]*=[[:space:]]*" |
| @@ -944,7 +945,7 @@ you have to define it using \\(?1:...\\) when adding new regexps. | |||
| 944 | When changed from Lisp, make sure to call | 945 | When changed from Lisp, make sure to call |
| 945 | `reftex-compile-variables' afterwards to make the change | 946 | `reftex-compile-variables' afterwards to make the change |
| 946 | effective." | 947 | effective." |
| 947 | :version "27.1" | 948 | :version "28.1" |
| 948 | :set (lambda (symbol value) | 949 | :set (lambda (symbol value) |
| 949 | (set symbol value) | 950 | (set symbol value) |
| 950 | (when (fboundp 'reftex-compile-variables) | 951 | (when (fboundp 'reftex-compile-variables) |
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 3da24c85c85..9ef2da737a4 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; w32-fns.el --- Lisp routines for 32-bit Windows | 1 | ;;; w32-fns.el --- Lisp routines for 32-bit Windows -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -383,10 +383,10 @@ for any permissions. | |||
| 383 | 383 | ||
| 384 | This is required because the Windows build environment is not required | 384 | This is required because the Windows build environment is not required |
| 385 | to include Sed, which is used by leim/Makefile.in to do the job." | 385 | to include Sed, which is used by leim/Makefile.in to do the job." |
| 386 | (find-file orig) | 386 | (with-current-buffer (find-file-noselect orig) |
| 387 | (goto-char (point-max)) | 387 | (goto-char (point-max)) |
| 388 | (insert-file-contents extra) | 388 | (insert-file-contents extra) |
| 389 | (delete-matching-lines "^$\\|^;") | 389 | (delete-matching-lines "^$\\|^;") |
| 390 | (save-buffers-kill-emacs t)) | 390 | (save-buffers-kill-emacs t))) |
| 391 | 391 | ||
| 392 | ;;; w32-fns.el ends here | 392 | ;;; w32-fns.el ends here |
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index f920130226e..8b10d71dcb3 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -1204,7 +1204,6 @@ This is much faster.") | |||
| 1204 | ARG may be negative to move backward. | 1204 | ARG may be negative to move backward. |
| 1205 | When the second optional argument is non-nil, | 1205 | When the second optional argument is non-nil, |
| 1206 | nothing is shown in the echo area." | 1206 | nothing is shown in the echo area." |
| 1207 | (or (bobp) (> arg 0) (backward-char)) | ||
| 1208 | (let ((wrapped 0) | 1207 | (let ((wrapped 0) |
| 1209 | (number arg) | 1208 | (number arg) |
| 1210 | (old (widget-tabable-at))) | 1209 | (old (widget-tabable-at))) |
diff --git a/lisp/widget.el b/lisp/widget.el index de690ad225d..401b4cf298f 100644 --- a/lisp/widget.el +++ b/lisp/widget.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; widget.el --- a library of user interface components | 1 | ;;; widget.el --- a library of user interface components -*- lexical-binding: t; -*- |
| 2 | ;; | 2 | ;; |
| 3 | ;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc. |
| 4 | ;; | 4 | ;; |
diff --git a/lisp/window.el b/lisp/window.el index cd13e6603a5..38be7789062 100644 --- a/lisp/window.el +++ b/lisp/window.el | |||
| @@ -7243,6 +7243,7 @@ The actual non-nil value of this variable will be copied to the | |||
| 7243 | (const display-buffer-below-selected) | 7243 | (const display-buffer-below-selected) |
| 7244 | (const display-buffer-at-bottom) | 7244 | (const display-buffer-at-bottom) |
| 7245 | (const display-buffer-in-previous-window) | 7245 | (const display-buffer-in-previous-window) |
| 7246 | (const display-buffer-use-least-recent-window) | ||
| 7246 | (const display-buffer-use-some-window) | 7247 | (const display-buffer-use-some-window) |
| 7247 | (const display-buffer-use-some-frame) | 7248 | (const display-buffer-use-some-frame) |
| 7248 | (function :tag "Other function")) | 7249 | (function :tag "Other function")) |
| @@ -7378,6 +7379,37 @@ fails, call `display-buffer-pop-up-frame'.") | |||
| 7378 | 7379 | ||
| 7379 | (defun display-buffer (buffer-or-name &optional action frame) | 7380 | (defun display-buffer (buffer-or-name &optional action frame) |
| 7380 | "Display BUFFER-OR-NAME in some window, without selecting it. | 7381 | "Display BUFFER-OR-NAME in some window, without selecting it. |
| 7382 | To change which window is used, set `display-buffer-alist' | ||
| 7383 | to an expression containing one of these \"action\" functions: | ||
| 7384 | |||
| 7385 | `display-buffer-same-window' -- Use the selected window. | ||
| 7386 | `display-buffer-reuse-window' -- Use a window already showing | ||
| 7387 | the buffer. | ||
| 7388 | `display-buffer-in-previous-window' -- Use a window that did | ||
| 7389 | show the buffer before. | ||
| 7390 | `display-buffer-use-some-window' -- Use some existing window. | ||
| 7391 | `display-buffer-use-least-recent-window' -- Try to avoid re-using | ||
| 7392 | windows that have recently been switched to. | ||
| 7393 | `display-buffer-pop-up-window' -- Pop up a new window. | ||
| 7394 | `display-buffer-below-selected' -- Use or pop up a window below | ||
| 7395 | the selected one. | ||
| 7396 | `display-buffer-at-bottom' -- Use or pop up a window at the | ||
| 7397 | bottom of the selected frame. | ||
| 7398 | `display-buffer-pop-up-frame' -- Show the buffer on a new frame. | ||
| 7399 | `display-buffer-in-child-frame' -- Show the buffer in a | ||
| 7400 | child frame. | ||
| 7401 | `display-buffer-no-window' -- Do not display the buffer and | ||
| 7402 | have `display-buffer' return nil immediately. | ||
| 7403 | |||
| 7404 | For instance: | ||
| 7405 | |||
| 7406 | (setq display-buffer-alist '((\".*\" display-buffer-at-bottom))) | ||
| 7407 | |||
| 7408 | Buffer display can be further customized to a very high degree; | ||
| 7409 | the rest of this docstring explains some of the many | ||
| 7410 | possibilities, and also see `(emacs)Window Choice' for more | ||
| 7411 | information. | ||
| 7412 | |||
| 7381 | BUFFER-OR-NAME must be a buffer or a string naming a live buffer. | 7413 | BUFFER-OR-NAME must be a buffer or a string naming a live buffer. |
| 7382 | Return the window chosen for displaying that buffer, or nil if no | 7414 | Return the window chosen for displaying that buffer, or nil if no |
| 7383 | such window is found. | 7415 | such window is found. |
| @@ -7403,23 +7435,8 @@ function in the combined function list in turn, passing the | |||
| 7403 | buffer as the first argument and the combined action alist as the | 7435 | buffer as the first argument and the combined action alist as the |
| 7404 | second argument, until one of the functions returns non-nil. | 7436 | second argument, until one of the functions returns non-nil. |
| 7405 | 7437 | ||
| 7406 | Action functions and the action they try to perform are: | 7438 | See above for the action functions and the action they try to |
| 7407 | `display-buffer-same-window' -- Use the selected window. | 7439 | perform. |
| 7408 | `display-buffer-reuse-window' -- Use a window already showing | ||
| 7409 | the buffer. | ||
| 7410 | `display-buffer-in-previous-window' -- Use a window that did | ||
| 7411 | show the buffer before. | ||
| 7412 | `display-buffer-use-some-window' -- Use some existing window. | ||
| 7413 | `display-buffer-pop-up-window' -- Pop up a new window. | ||
| 7414 | `display-buffer-below-selected' -- Use or pop up a window below | ||
| 7415 | the selected one. | ||
| 7416 | `display-buffer-at-bottom' -- Use or pop up a window at the | ||
| 7417 | bottom of the selected frame. | ||
| 7418 | `display-buffer-pop-up-frame' -- Show the buffer on a new frame. | ||
| 7419 | `display-buffer-in-child-frame' -- Show the buffer in a | ||
| 7420 | child frame. | ||
| 7421 | `display-buffer-no-window' -- Do not display the buffer and | ||
| 7422 | have `display-buffer' return nil immediately. | ||
| 7423 | 7440 | ||
| 7424 | Action alist entries are: | 7441 | Action alist entries are: |
| 7425 | `inhibit-same-window' -- A non-nil value prevents the same | 7442 | `inhibit-same-window' -- A non-nil value prevents the same |
| @@ -8242,6 +8259,16 @@ indirectly called by the latter." | |||
| 8242 | (when (setq window (or best-window second-best-window)) | 8259 | (when (setq window (or best-window second-best-window)) |
| 8243 | (window--display-buffer buffer window 'reuse alist)))) | 8260 | (window--display-buffer buffer window 'reuse alist)))) |
| 8244 | 8261 | ||
| 8262 | (defun display-buffer-use-least-recent-window (buffer alist) | ||
| 8263 | "Display BUFFER in an existing window, but that hasn't been used lately. | ||
| 8264 | This `display-buffer' action function is like | ||
| 8265 | `display-buffer-use-some-window', but will cycle through windows | ||
| 8266 | when displaying buffers repeatedly, and if there's only a single | ||
| 8267 | window, it will split the window." | ||
| 8268 | (when-let ((window (display-buffer-use-some-window | ||
| 8269 | buffer (cons (cons 'inhibit-same-window t) alist)))) | ||
| 8270 | (window-bump-use-time window))) | ||
| 8271 | |||
| 8245 | (defun display-buffer-use-some-window (buffer alist) | 8272 | (defun display-buffer-use-some-window (buffer alist) |
| 8246 | "Display BUFFER in an existing window. | 8273 | "Display BUFFER in an existing window. |
| 8247 | Search for a usable window, set that window to the buffer, and | 8274 | Search for a usable window, set that window to the buffer, and |
diff --git a/src/buffer.c b/src/buffer.c index 81f7d922fdb..71ad5edd527 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -2602,8 +2602,6 @@ current buffer is cleared. */) | |||
| 2602 | p += bytes, pos += bytes; | 2602 | p += bytes, pos += bytes; |
| 2603 | } | 2603 | } |
| 2604 | } | 2604 | } |
| 2605 | if (narrowed) | ||
| 2606 | Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv)); | ||
| 2607 | } | 2605 | } |
| 2608 | else | 2606 | else |
| 2609 | { | 2607 | { |
| @@ -2682,9 +2680,6 @@ current buffer is cleared. */) | |||
| 2682 | if (pt != PT) | 2680 | if (pt != PT) |
| 2683 | TEMP_SET_PT (pt); | 2681 | TEMP_SET_PT (pt); |
| 2684 | 2682 | ||
| 2685 | if (narrowed) | ||
| 2686 | Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv)); | ||
| 2687 | |||
| 2688 | /* Do this first, so that chars_in_text asks the right question. | 2683 | /* Do this first, so that chars_in_text asks the right question. |
| 2689 | set_intervals_multibyte needs it too. */ | 2684 | set_intervals_multibyte needs it too. */ |
| 2690 | bset_enable_multibyte_characters (current_buffer, Qt); | 2685 | bset_enable_multibyte_characters (current_buffer, Qt); |
| @@ -6385,10 +6380,3 @@ nil NORECORD argument since it may lead to infinite recursion. */); | |||
| 6385 | 6380 | ||
| 6386 | Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt); | 6381 | Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt); |
| 6387 | } | 6382 | } |
| 6388 | |||
| 6389 | void | ||
| 6390 | keys_of_buffer (void) | ||
| 6391 | { | ||
| 6392 | initial_define_key (control_x_map, 'b', "switch-to-buffer"); | ||
| 6393 | initial_define_key (control_x_map, 'k', "kill-buffer"); | ||
| 6394 | } | ||
diff --git a/src/callproc.c b/src/callproc.c index 8d2a5619eb8..1da315bef18 100644 --- a/src/callproc.c +++ b/src/callproc.c | |||
| @@ -314,6 +314,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 314 | #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ | 314 | #ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */ |
| 315 | char *tempfile = NULL; | 315 | char *tempfile = NULL; |
| 316 | #else | 316 | #else |
| 317 | sigset_t oldset; | ||
| 317 | pid_t pid = -1; | 318 | pid_t pid = -1; |
| 318 | #endif | 319 | #endif |
| 319 | int child_errno; | 320 | int child_errno; |
| @@ -601,9 +602,12 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 601 | 602 | ||
| 602 | #ifndef MSDOS | 603 | #ifndef MSDOS |
| 603 | 604 | ||
| 605 | block_input (); | ||
| 606 | block_child_signal (&oldset); | ||
| 607 | |||
| 604 | child_errno | 608 | child_errno |
| 605 | = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env, | 609 | = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env, |
| 606 | SSDATA (current_dir), NULL); | 610 | SSDATA (current_dir), NULL, &oldset); |
| 607 | eassert ((child_errno == 0) == (0 < pid)); | 611 | eassert ((child_errno == 0) == (0 < pid)); |
| 608 | 612 | ||
| 609 | if (pid > 0) | 613 | if (pid > 0) |
| @@ -624,6 +628,9 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 624 | } | 628 | } |
| 625 | } | 629 | } |
| 626 | 630 | ||
| 631 | unblock_child_signal (&oldset); | ||
| 632 | unblock_input (); | ||
| 633 | |||
| 627 | if (pid < 0) | 634 | if (pid < 0) |
| 628 | report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno); | 635 | report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno); |
| 629 | 636 | ||
| @@ -1227,17 +1234,21 @@ child_setup (int in, int out, int err, char **new_argv, char **env, | |||
| 1227 | process image file ARGV[0]. Use ENVP for the environment block for | 1234 | process image file ARGV[0]. Use ENVP for the environment block for |
| 1228 | the new process. Use CWD as working directory for the new process. | 1235 | the new process. Use CWD as working directory for the new process. |
| 1229 | If PTY is not NULL, it must be a pseudoterminal device. If PTY is | 1236 | If PTY is not NULL, it must be a pseudoterminal device. If PTY is |
| 1230 | NULL, don't perform any terminal setup. */ | 1237 | NULL, don't perform any terminal setup. OLDSET must be a pointer |
| 1238 | to a signal set initialized by `block_child_signal'. Before | ||
| 1239 | calling this function, call `block_input' and `block_child_signal'; | ||
| 1240 | afterwards, call `unblock_input' and `unblock_child_signal'. Be | ||
| 1241 | sure to call `unblock_child_signal' only after registering NEWPID | ||
| 1242 | in a list where `handle_child_signal' can find it! */ | ||
| 1231 | 1243 | ||
| 1232 | int | 1244 | int |
| 1233 | emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, | 1245 | emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, |
| 1234 | char **argv, char **envp, const char *cwd, const char *pty) | 1246 | char **argv, char **envp, const char *cwd, |
| 1247 | const char *pty, const sigset_t *oldset) | ||
| 1235 | { | 1248 | { |
| 1236 | sigset_t oldset; | ||
| 1237 | int pid; | 1249 | int pid; |
| 1238 | 1250 | ||
| 1239 | block_input (); | 1251 | eassert (input_blocked_p ()); |
| 1240 | block_child_signal (&oldset); | ||
| 1241 | 1252 | ||
| 1242 | #ifndef WINDOWSNT | 1253 | #ifndef WINDOWSNT |
| 1243 | /* vfork, and prevent local vars from being clobbered by the vfork. */ | 1254 | /* vfork, and prevent local vars from being clobbered by the vfork. */ |
| @@ -1249,6 +1260,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, | |||
| 1249 | int volatile stdout_volatile = std_out; | 1260 | int volatile stdout_volatile = std_out; |
| 1250 | int volatile stderr_volatile = std_err; | 1261 | int volatile stderr_volatile = std_err; |
| 1251 | char **volatile envp_volatile = envp; | 1262 | char **volatile envp_volatile = envp; |
| 1263 | const sigset_t *volatile oldset_volatile = oldset; | ||
| 1252 | 1264 | ||
| 1253 | #ifdef DARWIN_OS | 1265 | #ifdef DARWIN_OS |
| 1254 | /* Darwin doesn't let us run setsid after a vfork, so use fork when | 1266 | /* Darwin doesn't let us run setsid after a vfork, so use fork when |
| @@ -1270,6 +1282,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, | |||
| 1270 | std_out = stdout_volatile; | 1282 | std_out = stdout_volatile; |
| 1271 | std_err = stderr_volatile; | 1283 | std_err = stderr_volatile; |
| 1272 | envp = envp_volatile; | 1284 | envp = envp_volatile; |
| 1285 | oldset = oldset_volatile; | ||
| 1273 | 1286 | ||
| 1274 | if (pid == 0) | 1287 | if (pid == 0) |
| 1275 | #endif /* not WINDOWSNT */ | 1288 | #endif /* not WINDOWSNT */ |
| @@ -1364,7 +1377,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, | |||
| 1364 | #endif | 1377 | #endif |
| 1365 | 1378 | ||
| 1366 | /* Stop blocking SIGCHLD in the child. */ | 1379 | /* Stop blocking SIGCHLD in the child. */ |
| 1367 | unblock_child_signal (&oldset); | 1380 | unblock_child_signal (oldset); |
| 1368 | 1381 | ||
| 1369 | if (pty_flag) | 1382 | if (pty_flag) |
| 1370 | child_setup_tty (std_out); | 1383 | child_setup_tty (std_out); |
| @@ -1382,10 +1395,6 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, | |||
| 1382 | 1395 | ||
| 1383 | int vfork_error = pid < 0 ? errno : 0; | 1396 | int vfork_error = pid < 0 ? errno : 0; |
| 1384 | 1397 | ||
| 1385 | /* Stop blocking in the parent. */ | ||
| 1386 | unblock_child_signal (&oldset); | ||
| 1387 | unblock_input (); | ||
| 1388 | |||
| 1389 | if (pid < 0) | 1398 | if (pid < 0) |
| 1390 | { | 1399 | { |
| 1391 | eassert (0 < vfork_error); | 1400 | eassert (0 < vfork_error); |
diff --git a/src/casefiddle.c b/src/casefiddle.c index a948bb3bc88..a7a25414909 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c | |||
| @@ -682,16 +682,3 @@ Called with one argument METHOD which can be: | |||
| 682 | defsubr (&Sdowncase_word); | 682 | defsubr (&Sdowncase_word); |
| 683 | defsubr (&Scapitalize_word); | 683 | defsubr (&Scapitalize_word); |
| 684 | } | 684 | } |
| 685 | |||
| 686 | void | ||
| 687 | keys_of_casefiddle (void) | ||
| 688 | { | ||
| 689 | initial_define_key (control_x_map, Ctl ('U'), "upcase-region"); | ||
| 690 | Fput (intern ("upcase-region"), Qdisabled, Qt); | ||
| 691 | initial_define_key (control_x_map, Ctl ('L'), "downcase-region"); | ||
| 692 | Fput (intern ("downcase-region"), Qdisabled, Qt); | ||
| 693 | |||
| 694 | initial_define_key (meta_map, 'u', "upcase-word"); | ||
| 695 | initial_define_key (meta_map, 'l', "downcase-word"); | ||
| 696 | initial_define_key (meta_map, 'c', "capitalize-word"); | ||
| 697 | } | ||
diff --git a/src/cmds.c b/src/cmds.c index 798fd68a920..1547db80e88 100644 --- a/src/cmds.c +++ b/src/cmds.c | |||
| @@ -529,24 +529,3 @@ This is run after inserting the character. */); | |||
| 529 | defsubr (&Sdelete_char); | 529 | defsubr (&Sdelete_char); |
| 530 | defsubr (&Sself_insert_command); | 530 | defsubr (&Sself_insert_command); |
| 531 | } | 531 | } |
| 532 | |||
| 533 | void | ||
| 534 | keys_of_cmds (void) | ||
| 535 | { | ||
| 536 | int n; | ||
| 537 | |||
| 538 | initial_define_key (global_map, Ctl ('I'), "self-insert-command"); | ||
| 539 | for (n = 040; n < 0177; n++) | ||
| 540 | initial_define_key (global_map, n, "self-insert-command"); | ||
| 541 | #ifdef MSDOS | ||
| 542 | for (n = 0200; n < 0240; n++) | ||
| 543 | initial_define_key (global_map, n, "self-insert-command"); | ||
| 544 | #endif | ||
| 545 | for (n = 0240; n < 0400; n++) | ||
| 546 | initial_define_key (global_map, n, "self-insert-command"); | ||
| 547 | |||
| 548 | initial_define_key (global_map, Ctl ('A'), "beginning-of-line"); | ||
| 549 | initial_define_key (global_map, Ctl ('B'), "backward-char"); | ||
| 550 | initial_define_key (global_map, Ctl ('E'), "end-of-line"); | ||
| 551 | initial_define_key (global_map, Ctl ('F'), "forward-char"); | ||
| 552 | } | ||
diff --git a/src/commands.h b/src/commands.h index a09858d050d..2205ebf7d39 100644 --- a/src/commands.h +++ b/src/commands.h | |||
| @@ -23,14 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 23 | 23 | ||
| 24 | #define Ctl(c) ((c)&037) | 24 | #define Ctl(c) ((c)&037) |
| 25 | 25 | ||
| 26 | /* Define the names of keymaps, just so people can refer to them in | ||
| 27 | calls to initial_define_key. These should *not* be used after | ||
| 28 | initialization; use-global-map doesn't affect these; it sets | ||
| 29 | current_global_map instead. */ | ||
| 30 | extern Lisp_Object global_map; | ||
| 31 | extern Lisp_Object meta_map; | ||
| 32 | extern Lisp_Object control_x_map; | ||
| 33 | |||
| 34 | /* If not Qnil, this is a switch-frame event which we decided to put | 26 | /* If not Qnil, this is a switch-frame event which we decided to put |
| 35 | off until the end of a key sequence. This should be read as the | 27 | off until the end of a key sequence. This should be read as the |
| 36 | next command input, after any Vunread_command_events. | 28 | next command input, after any Vunread_command_events. |
diff --git a/src/emacs.c b/src/emacs.c index 61d2023b4da..461d1b72e4c 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -1969,12 +1969,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem | |||
| 1969 | syms_of_json (); | 1969 | syms_of_json (); |
| 1970 | #endif | 1970 | #endif |
| 1971 | 1971 | ||
| 1972 | keys_of_casefiddle (); | ||
| 1973 | keys_of_cmds (); | ||
| 1974 | keys_of_buffer (); | ||
| 1975 | keys_of_keyboard (); | 1972 | keys_of_keyboard (); |
| 1976 | keys_of_keymap (); | ||
| 1977 | keys_of_window (); | ||
| 1978 | } | 1973 | } |
| 1979 | else | 1974 | else |
| 1980 | { | 1975 | { |
diff --git a/src/keyboard.c b/src/keyboard.c index 2446f078fde..4540b3179b5 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -285,7 +285,7 @@ bool input_pending; | |||
| 285 | with the input rate, but if it can keep up just enough that there's no | 285 | with the input rate, but if it can keep up just enough that there's no |
| 286 | input_pending when we begin the command, then redisplay is not skipped | 286 | input_pending when we begin the command, then redisplay is not skipped |
| 287 | which results in better feedback to the user. */ | 287 | which results in better feedback to the user. */ |
| 288 | static bool input_was_pending; | 288 | bool input_was_pending; |
| 289 | 289 | ||
| 290 | /* Circular buffer for pre-read keyboard input. */ | 290 | /* Circular buffer for pre-read keyboard input. */ |
| 291 | 291 | ||
| @@ -12396,12 +12396,6 @@ syms_of_keyboard_for_pdumper (void) | |||
| 12396 | void | 12396 | void |
| 12397 | keys_of_keyboard (void) | 12397 | keys_of_keyboard (void) |
| 12398 | { | 12398 | { |
| 12399 | initial_define_key (global_map, Ctl ('Z'), "suspend-emacs"); | ||
| 12400 | initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs"); | ||
| 12401 | initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit"); | ||
| 12402 | initial_define_key (global_map, Ctl (']'), "abort-recursive-edit"); | ||
| 12403 | initial_define_key (meta_map, 'x', "execute-extended-command"); | ||
| 12404 | |||
| 12405 | initial_define_lispy_key (Vspecial_event_map, "delete-frame", | 12399 | initial_define_lispy_key (Vspecial_event_map, "delete-frame", |
| 12406 | "handle-delete-frame"); | 12400 | "handle-delete-frame"); |
| 12407 | #ifdef HAVE_NTGUI | 12401 | #ifdef HAVE_NTGUI |
diff --git a/src/keyboard.h b/src/keyboard.h index 91c6f4604f9..8bdffaa2bff 100644 --- a/src/keyboard.h +++ b/src/keyboard.h | |||
| @@ -432,7 +432,7 @@ extern int parse_solitary_modifier (Lisp_Object symbol); | |||
| 432 | extern Lisp_Object real_this_command; | 432 | extern Lisp_Object real_this_command; |
| 433 | 433 | ||
| 434 | extern int quit_char; | 434 | extern int quit_char; |
| 435 | 435 | extern bool input_was_pending; | |
| 436 | extern unsigned int timers_run; | 436 | extern unsigned int timers_run; |
| 437 | 437 | ||
| 438 | extern bool menu_separator_name_p (const char *); | 438 | extern bool menu_separator_name_p (const char *); |
diff --git a/src/keymap.c b/src/keymap.c index 1eeea81f627..1197f6fd4a5 100644 --- a/src/keymap.c +++ b/src/keymap.c | |||
| @@ -59,22 +59,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 59 | 59 | ||
| 60 | Lisp_Object current_global_map; /* Current global keymap. */ | 60 | Lisp_Object current_global_map; /* Current global keymap. */ |
| 61 | 61 | ||
| 62 | Lisp_Object global_map; /* Default global key bindings. */ | ||
| 63 | |||
| 64 | Lisp_Object meta_map; /* The keymap used for globally bound | ||
| 65 | ESC-prefixed default commands. */ | ||
| 66 | |||
| 67 | Lisp_Object control_x_map; /* The keymap used for globally bound | ||
| 68 | C-x-prefixed default commands. */ | ||
| 69 | |||
| 70 | /* The keymap used by the minibuf for local | ||
| 71 | bindings when spaces are allowed in the | ||
| 72 | minibuf. */ | ||
| 73 | |||
| 74 | /* The keymap used by the minibuf for local | ||
| 75 | bindings when spaces are not encouraged | ||
| 76 | in the minibuf. */ | ||
| 77 | |||
| 78 | /* Alist of elements like (DEL . "\d"). */ | 62 | /* Alist of elements like (DEL . "\d"). */ |
| 79 | static Lisp_Object exclude_keys; | 63 | static Lisp_Object exclude_keys; |
| 80 | 64 | ||
| @@ -140,19 +124,6 @@ in case you use it as a menu with `x-popup-menu'. */) | |||
| 140 | return list1 (Qkeymap); | 124 | return list1 (Qkeymap); |
| 141 | } | 125 | } |
| 142 | 126 | ||
| 143 | /* This function is used for installing the standard key bindings | ||
| 144 | at initialization time. | ||
| 145 | |||
| 146 | For example: | ||
| 147 | |||
| 148 | initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */ | ||
| 149 | |||
| 150 | void | ||
| 151 | initial_define_key (Lisp_Object keymap, int key, const char *defname) | ||
| 152 | { | ||
| 153 | store_in_keymap (keymap, make_fixnum (key), intern_c_string (defname)); | ||
| 154 | } | ||
| 155 | |||
| 156 | void | 127 | void |
| 157 | initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname) | 128 | initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname) |
| 158 | { | 129 | { |
| @@ -1741,28 +1712,6 @@ bindings; see the description of `lookup-key' for more details about this. */) | |||
| 1741 | return Flist (j, maps); | 1712 | return Flist (j, maps); |
| 1742 | } | 1713 | } |
| 1743 | 1714 | ||
| 1744 | DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0, | ||
| 1745 | doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol. | ||
| 1746 | A new sparse keymap is stored as COMMAND's function definition and its | ||
| 1747 | value. | ||
| 1748 | This prepares COMMAND for use as a prefix key's binding. | ||
| 1749 | If a second optional argument MAPVAR is given, it should be a symbol. | ||
| 1750 | The map is then stored as MAPVAR's value instead of as COMMAND's | ||
| 1751 | value; but COMMAND is still defined as a function. | ||
| 1752 | The third optional argument NAME, if given, supplies a menu name | ||
| 1753 | string for the map. This is required to use the keymap as a menu. | ||
| 1754 | This function returns COMMAND. */) | ||
| 1755 | (Lisp_Object command, Lisp_Object mapvar, Lisp_Object name) | ||
| 1756 | { | ||
| 1757 | Lisp_Object map = Fmake_sparse_keymap (name); | ||
| 1758 | Ffset (command, map); | ||
| 1759 | if (!NILP (mapvar)) | ||
| 1760 | Fset (mapvar, map); | ||
| 1761 | else | ||
| 1762 | Fset (command, map); | ||
| 1763 | return command; | ||
| 1764 | } | ||
| 1765 | |||
| 1766 | DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, | 1715 | DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0, |
| 1767 | doc: /* Select KEYMAP as the global keymap. */) | 1716 | doc: /* Select KEYMAP as the global keymap. */) |
| 1768 | (Lisp_Object keymap) | 1717 | (Lisp_Object keymap) |
| @@ -2217,11 +2166,21 @@ See `text-char-description' for describing character codes. */) | |||
| 2217 | { | 2166 | { |
| 2218 | if (NILP (no_angles)) | 2167 | if (NILP (no_angles)) |
| 2219 | { | 2168 | { |
| 2220 | Lisp_Object result; | 2169 | Lisp_Object namestr = SYMBOL_NAME (key); |
| 2221 | char *buffer = SAFE_ALLOCA (sizeof "<>" | 2170 | const char *sym = SSDATA (namestr); |
| 2222 | + SBYTES (SYMBOL_NAME (key))); | 2171 | ptrdiff_t len = SBYTES (namestr); |
| 2223 | esprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key))); | 2172 | /* Find the extent of the modifier prefix, like "C-M-". */ |
| 2224 | result = build_string (buffer); | 2173 | int i = 0; |
| 2174 | while (i < len - 3 && sym[i + 1] == '-' && strchr ("CMSsHA", sym[i])) | ||
| 2175 | i += 2; | ||
| 2176 | /* First I bytes of SYM are modifiers; put <> around the rest. */ | ||
| 2177 | char *buffer = SAFE_ALLOCA (len + 3); | ||
| 2178 | memcpy (buffer, sym, i); | ||
| 2179 | buffer[i] = '<'; | ||
| 2180 | memcpy (buffer + i + 1, sym + i, len - i); | ||
| 2181 | buffer [len + 1] = '>'; | ||
| 2182 | buffer [len + 2] = '\0'; | ||
| 2183 | Lisp_Object result = build_string (buffer); | ||
| 2225 | SAFE_FREE (); | 2184 | SAFE_FREE (); |
| 2226 | return result; | 2185 | return result; |
| 2227 | } | 2186 | } |
| @@ -3195,21 +3154,9 @@ syms_of_keymap (void) | |||
| 3195 | Each one is the value of a Lisp variable, and is also | 3154 | Each one is the value of a Lisp variable, and is also |
| 3196 | pointed to by a C variable */ | 3155 | pointed to by a C variable */ |
| 3197 | 3156 | ||
| 3198 | global_map = Fmake_keymap (Qnil); | 3157 | current_global_map = Qnil; |
| 3199 | Fset (intern_c_string ("global-map"), global_map); | ||
| 3200 | |||
| 3201 | current_global_map = global_map; | ||
| 3202 | staticpro (&global_map); | ||
| 3203 | staticpro (¤t_global_map); | 3158 | staticpro (¤t_global_map); |
| 3204 | 3159 | ||
| 3205 | meta_map = Fmake_keymap (Qnil); | ||
| 3206 | Fset (intern_c_string ("esc-map"), meta_map); | ||
| 3207 | Ffset (intern_c_string ("ESC-prefix"), meta_map); | ||
| 3208 | |||
| 3209 | control_x_map = Fmake_keymap (Qnil); | ||
| 3210 | Fset (intern_c_string ("ctl-x-map"), control_x_map); | ||
| 3211 | Ffset (intern_c_string ("Control-X-prefix"), control_x_map); | ||
| 3212 | |||
| 3213 | exclude_keys = pure_list | 3160 | exclude_keys = pure_list |
| 3214 | (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), | 3161 | (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), |
| 3215 | pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")), | 3162 | pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")), |
| @@ -3311,7 +3258,6 @@ be preferred. */); | |||
| 3311 | defsubr (&Sminor_mode_key_binding); | 3258 | defsubr (&Sminor_mode_key_binding); |
| 3312 | defsubr (&Sdefine_key); | 3259 | defsubr (&Sdefine_key); |
| 3313 | defsubr (&Slookup_key); | 3260 | defsubr (&Slookup_key); |
| 3314 | defsubr (&Sdefine_prefix_command); | ||
| 3315 | defsubr (&Suse_global_map); | 3261 | defsubr (&Suse_global_map); |
| 3316 | defsubr (&Suse_local_map); | 3262 | defsubr (&Suse_local_map); |
| 3317 | defsubr (&Scurrent_local_map); | 3263 | defsubr (&Scurrent_local_map); |
| @@ -3328,10 +3274,3 @@ be preferred. */); | |||
| 3328 | defsubr (&Swhere_is_internal); | 3274 | defsubr (&Swhere_is_internal); |
| 3329 | defsubr (&Sdescribe_buffer_bindings); | 3275 | defsubr (&Sdescribe_buffer_bindings); |
| 3330 | } | 3276 | } |
| 3331 | |||
| 3332 | void | ||
| 3333 | keys_of_keymap (void) | ||
| 3334 | { | ||
| 3335 | initial_define_key (global_map, 033, "ESC-prefix"); | ||
| 3336 | initial_define_key (global_map, Ctl ('X'), "Control-X-prefix"); | ||
| 3337 | } | ||
diff --git a/src/keymap.h b/src/keymap.h index 072c09348e2..f417301c8f2 100644 --- a/src/keymap.h +++ b/src/keymap.h | |||
| @@ -37,10 +37,8 @@ extern char *push_key_description (EMACS_INT, char *); | |||
| 37 | extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool); | 37 | extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool); |
| 38 | extern Lisp_Object get_keymap (Lisp_Object, bool, bool); | 38 | extern Lisp_Object get_keymap (Lisp_Object, bool, bool); |
| 39 | extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **); | 39 | extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **); |
| 40 | extern void initial_define_key (Lisp_Object, int, const char *); | ||
| 41 | extern void initial_define_lispy_key (Lisp_Object, const char *, const char *); | 40 | extern void initial_define_lispy_key (Lisp_Object, const char *, const char *); |
| 42 | extern void syms_of_keymap (void); | 41 | extern void syms_of_keymap (void); |
| 43 | extern void keys_of_keymap (void); | ||
| 44 | 42 | ||
| 45 | typedef void (*map_keymap_function_t) | 43 | typedef void (*map_keymap_function_t) |
| 46 | (Lisp_Object key, Lisp_Object val, Lisp_Object args, void *data); | 44 | (Lisp_Object key, Lisp_Object val, Lisp_Object args, void *data); |
diff --git a/src/lisp.h b/src/lisp.h index 0ad788cff84..d139df93424 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -1478,8 +1478,8 @@ struct Lisp_String | |||
| 1478 | { | 1478 | { |
| 1479 | struct | 1479 | struct |
| 1480 | { | 1480 | { |
| 1481 | ptrdiff_t size; | 1481 | ptrdiff_t size; /* MSB is used as the markbit. */ |
| 1482 | ptrdiff_t size_byte; | 1482 | ptrdiff_t size_byte; /* Set to -1 for unibyte strings. */ |
| 1483 | INTERVAL intervals; /* Text properties in this string. */ | 1483 | INTERVAL intervals; /* Text properties in this string. */ |
| 1484 | unsigned char *data; | 1484 | unsigned char *data; |
| 1485 | } s; | 1485 | } s; |
| @@ -3561,7 +3561,6 @@ extern void swap_in_global_binding (struct Lisp_Symbol *); | |||
| 3561 | 3561 | ||
| 3562 | /* Defined in cmds.c */ | 3562 | /* Defined in cmds.c */ |
| 3563 | extern void syms_of_cmds (void); | 3563 | extern void syms_of_cmds (void); |
| 3564 | extern void keys_of_cmds (void); | ||
| 3565 | 3564 | ||
| 3566 | /* Defined in coding.c. */ | 3565 | /* Defined in coding.c. */ |
| 3567 | extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t, | 3566 | extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t, |
| @@ -4262,7 +4261,6 @@ extern Lisp_Object get_truename_buffer (Lisp_Object); | |||
| 4262 | extern void init_buffer_once (void); | 4261 | extern void init_buffer_once (void); |
| 4263 | extern void init_buffer (void); | 4262 | extern void init_buffer (void); |
| 4264 | extern void syms_of_buffer (void); | 4263 | extern void syms_of_buffer (void); |
| 4265 | extern void keys_of_buffer (void); | ||
| 4266 | 4264 | ||
| 4267 | /* Defined in marker.c. */ | 4265 | /* Defined in marker.c. */ |
| 4268 | 4266 | ||
| @@ -4359,7 +4357,6 @@ extern void syms_of_callint (void); | |||
| 4359 | /* Defined in casefiddle.c. */ | 4357 | /* Defined in casefiddle.c. */ |
| 4360 | 4358 | ||
| 4361 | extern void syms_of_casefiddle (void); | 4359 | extern void syms_of_casefiddle (void); |
| 4362 | extern void keys_of_casefiddle (void); | ||
| 4363 | 4360 | ||
| 4364 | /* Defined in casetab.c. */ | 4361 | /* Defined in casetab.c. */ |
| 4365 | 4362 | ||
| @@ -4498,8 +4495,8 @@ extern void setup_process_coding_systems (Lisp_Object); | |||
| 4498 | # define CHILD_SETUP_ERROR_DESC "Doing vfork" | 4495 | # define CHILD_SETUP_ERROR_DESC "Doing vfork" |
| 4499 | #endif | 4496 | #endif |
| 4500 | 4497 | ||
| 4501 | extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *, | 4498 | extern int emacs_spawn (pid_t *, int, int, int, char **, char **, |
| 4502 | const char *); | 4499 | const char *, const char *, const sigset_t *); |
| 4503 | extern char **make_environment_block (Lisp_Object); | 4500 | extern char **make_environment_block (Lisp_Object); |
| 4504 | extern void init_callproc_1 (void); | 4501 | extern void init_callproc_1 (void); |
| 4505 | extern void init_callproc (void); | 4502 | extern void init_callproc (void); |
diff --git a/src/minibuf.c b/src/minibuf.c index 8b235690199..5ee440f6622 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -2013,9 +2013,6 @@ syms_of_minibuf (void) | |||
| 2013 | DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook"); | 2013 | DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook"); |
| 2014 | DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook"); | 2014 | DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook"); |
| 2015 | 2015 | ||
| 2016 | /* The maximum length of a minibuffer history. */ | ||
| 2017 | DEFSYM (Qhistory_length, "history-length"); | ||
| 2018 | |||
| 2019 | DEFSYM (Qcurrent_input_method, "current-input-method"); | 2016 | DEFSYM (Qcurrent_input_method, "current-input-method"); |
| 2020 | DEFSYM (Qactivate_input_method, "activate-input-method"); | 2017 | DEFSYM (Qactivate_input_method, "activate-input-method"); |
| 2021 | DEFSYM (Qcase_fold_search, "case-fold-search"); | 2018 | DEFSYM (Qcase_fold_search, "case-fold-search"); |
diff --git a/src/nsfns.m b/src/nsfns.m index ee2daea0723..ae114f83e4d 100644 --- a/src/nsfns.m +++ b/src/nsfns.m | |||
| @@ -1485,14 +1485,14 @@ Some window managers may refuse to restack windows. */) | |||
| 1485 | 1485 | ||
| 1486 | if (FRAME_NS_VIEW (f1) && FRAME_NS_VIEW (f2)) | 1486 | if (FRAME_NS_VIEW (f1) && FRAME_NS_VIEW (f2)) |
| 1487 | { | 1487 | { |
| 1488 | NSWindow *window = [FRAME_NS_VIEW (f1) window]; | 1488 | EmacsWindow *window = (EmacsWindow *)[FRAME_NS_VIEW (f1) window]; |
| 1489 | NSInteger window2 = [[FRAME_NS_VIEW (f2) window] windowNumber]; | 1489 | NSWindow *window2 = [FRAME_NS_VIEW (f2) window]; |
| 1490 | NSWindowOrderingMode flag = NILP (above) ? NSWindowBelow : NSWindowAbove; | 1490 | BOOL flag = !NILP (above); |
| 1491 | 1491 | ||
| 1492 | [window orderWindow: flag | 1492 | if ([window restackWindow:window2 above:!NILP (above)]) |
| 1493 | relativeTo: window2]; | 1493 | return Qt; |
| 1494 | 1494 | else | |
| 1495 | return Qt; | 1495 | return Qnil; |
| 1496 | } | 1496 | } |
| 1497 | else | 1497 | else |
| 1498 | { | 1498 | { |
diff --git a/src/nsmenu.m b/src/nsmenu.m index 9b56958100a..8086f56854e 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m | |||
| @@ -145,6 +145,10 @@ ns_update_menubar (struct frame *f, bool deep_p) | |||
| 145 | t = -(1000*tb.time+tb.millitm); | 145 | t = -(1000*tb.time+tb.millitm); |
| 146 | #endif | 146 | #endif |
| 147 | 147 | ||
| 148 | #ifdef NS_IMPL_GNUSTEP | ||
| 149 | deep_p = 1; /* See comment in menuNeedsUpdate. */ | ||
| 150 | #endif | ||
| 151 | |||
| 148 | if (deep_p) | 152 | if (deep_p) |
| 149 | { | 153 | { |
| 150 | /* Make a widget-value tree representing the entire menu trees. */ | 154 | /* Make a widget-value tree representing the entire menu trees. */ |
| @@ -433,21 +437,22 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) | |||
| 433 | } | 437 | } |
| 434 | 438 | ||
| 435 | 439 | ||
| 436 | /* Delegate method called when a submenu is being opened: run a 'deep' call | 440 | /* Delegate method called when a submenu is being opened: run a 'deep' |
| 437 | to set_frame_menubar. */ | 441 | call to ns_update_menubar. */ |
| 438 | |||
| 439 | /* TODO: GNUstep calls this method when the menu is still being built | ||
| 440 | which throws it into an infinite loop. One possible solution is to | ||
| 441 | use menuWillOpen instead, but the Apple docs explicitly warn | ||
| 442 | against changing the contents of the menu in it. I don't know what | ||
| 443 | the right thing to do for GNUstep is. */ | ||
| 444 | - (void)menuNeedsUpdate: (NSMenu *)menu | 442 | - (void)menuNeedsUpdate: (NSMenu *)menu |
| 445 | { | 443 | { |
| 446 | if (!FRAME_LIVE_P (SELECTED_FRAME ())) | 444 | if (!FRAME_LIVE_P (SELECTED_FRAME ())) |
| 447 | return; | 445 | return; |
| 448 | 446 | ||
| 447 | #ifdef NS_IMPL_COCOA | ||
| 448 | /* TODO: GNUstep calls this method when the menu is still being built | ||
| 449 | which results in a recursive stack overflow. One possible solution | ||
| 450 | is to use menuWillOpen instead, but the Apple docs explicitly warn | ||
| 451 | against changing the contents of the menu in it. I don't know what | ||
| 452 | the right thing to do for GNUstep is. */ | ||
| 449 | if (needsUpdate) | 453 | if (needsUpdate) |
| 450 | ns_update_menubar (SELECTED_FRAME (), true); | 454 | ns_update_menubar (SELECTED_FRAME (), true); |
| 455 | #endif | ||
| 451 | } | 456 | } |
| 452 | 457 | ||
| 453 | 458 | ||
diff --git a/src/nsterm.h b/src/nsterm.h index 3fb64494f76..2c9d8e85ba9 100644 --- a/src/nsterm.h +++ b/src/nsterm.h | |||
| @@ -498,6 +498,7 @@ typedef id instancetype; | |||
| 498 | NSPoint grabOffset; | 498 | NSPoint grabOffset; |
| 499 | } | 499 | } |
| 500 | 500 | ||
| 501 | - (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above; | ||
| 501 | - (void)setAppearance; | 502 | - (void)setAppearance; |
| 502 | @end | 503 | @end |
| 503 | 504 | ||
diff --git a/src/nsterm.m b/src/nsterm.m index 27310639508..2defb9e2eec 100644 --- a/src/nsterm.m +++ b/src/nsterm.m | |||
| @@ -8693,6 +8693,112 @@ not_in_argv (NSString *arg) | |||
| 8693 | 8693 | ||
| 8694 | @implementation EmacsWindow | 8694 | @implementation EmacsWindow |
| 8695 | 8695 | ||
| 8696 | /* It seems the only way to reorder child frames is by removing them | ||
| 8697 | from the parent and then reattaching them in the correct order. */ | ||
| 8698 | |||
| 8699 | - (void)orderFront:(id)sender | ||
| 8700 | { | ||
| 8701 | NSTRACE ("[EmacsWindow orderFront:]"); | ||
| 8702 | |||
| 8703 | NSWindow *parent = [self parentWindow]; | ||
| 8704 | if (parent) | ||
| 8705 | { | ||
| 8706 | [parent removeChildWindow:self]; | ||
| 8707 | [parent addChildWindow:self ordered:NSWindowAbove]; | ||
| 8708 | } | ||
| 8709 | else | ||
| 8710 | [super orderFront:sender]; | ||
| 8711 | } | ||
| 8712 | |||
| 8713 | - (void)makeKeyAndOrderFront:(id)sender | ||
| 8714 | { | ||
| 8715 | NSTRACE ("[EmacsWindow makeKeyAndOrderFront:]"); | ||
| 8716 | |||
| 8717 | if ([self parentWindow]) | ||
| 8718 | { | ||
| 8719 | [self orderFront:sender]; | ||
| 8720 | [self makeKeyWindow]; | ||
| 8721 | } | ||
| 8722 | else | ||
| 8723 | [super makeKeyAndOrderFront:sender]; | ||
| 8724 | } | ||
| 8725 | |||
| 8726 | |||
| 8727 | /* The array returned by [NSWindow parentWindow] may already be | ||
| 8728 | sorted, but the documentation doesn't tell us whether or not it is, | ||
| 8729 | so to be safe we'll sort it. */ | ||
| 8730 | NSInteger nswindow_orderedIndex_sort (id w1, id w2, void *c) | ||
| 8731 | { | ||
| 8732 | NSInteger i1 = [w1 orderedIndex]; | ||
| 8733 | NSInteger i2 = [w2 orderedIndex]; | ||
| 8734 | |||
| 8735 | if (i1 > i2) | ||
| 8736 | return NSOrderedAscending; | ||
| 8737 | if (i1 < i2) | ||
| 8738 | return NSOrderedDescending; | ||
| 8739 | |||
| 8740 | return NSOrderedSame; | ||
| 8741 | } | ||
| 8742 | |||
| 8743 | - (void)orderBack:(id)sender | ||
| 8744 | { | ||
| 8745 | NSTRACE ("[EmacsWindow orderBack:]"); | ||
| 8746 | |||
| 8747 | NSWindow *parent = [self parentWindow]; | ||
| 8748 | if (parent) | ||
| 8749 | { | ||
| 8750 | NSArray *children = [[parent childWindows] | ||
| 8751 | sortedArrayUsingFunction:nswindow_orderedIndex_sort | ||
| 8752 | context:nil]; | ||
| 8753 | [parent removeChildWindow:self]; | ||
| 8754 | [parent addChildWindow:self ordered:NSWindowAbove]; | ||
| 8755 | |||
| 8756 | for (NSWindow *win in children) | ||
| 8757 | { | ||
| 8758 | if (win != self) | ||
| 8759 | { | ||
| 8760 | [parent removeChildWindow:win]; | ||
| 8761 | [parent addChildWindow:win ordered:NSWindowAbove]; | ||
| 8762 | } | ||
| 8763 | } | ||
| 8764 | } | ||
| 8765 | else | ||
| 8766 | [super orderBack:sender]; | ||
| 8767 | } | ||
| 8768 | |||
| 8769 | - (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above | ||
| 8770 | { | ||
| 8771 | NSTRACE ("[EmacsWindow restackWindow:above:]"); | ||
| 8772 | |||
| 8773 | /* If parent windows don't match we can't restack these frames | ||
| 8774 | without changing the parents. */ | ||
| 8775 | if ([self parentWindow] != [win parentWindow]) | ||
| 8776 | return NO; | ||
| 8777 | else if (![self parentWindow]) | ||
| 8778 | [self orderWindow:(above ? NSWindowAbove : NSWindowBelow) | ||
| 8779 | relativeTo:[win windowNumber]]; | ||
| 8780 | else | ||
| 8781 | { | ||
| 8782 | NSInteger index; | ||
| 8783 | NSWindow *parent = [self parentWindow]; | ||
| 8784 | NSMutableArray *children = [[[parent childWindows] | ||
| 8785 | sortedArrayUsingFunction:nswindow_orderedIndex_sort | ||
| 8786 | context:nil] | ||
| 8787 | mutableCopy]; | ||
| 8788 | [children removeObject:self]; | ||
| 8789 | index = [children indexOfObject:win]; | ||
| 8790 | [children insertObject:self atIndex:(above ? index+1 : index)]; | ||
| 8791 | |||
| 8792 | for (NSWindow *w in children) | ||
| 8793 | { | ||
| 8794 | [parent removeChildWindow:w]; | ||
| 8795 | [parent addChildWindow:w ordered:NSWindowAbove]; | ||
| 8796 | } | ||
| 8797 | } | ||
| 8798 | |||
| 8799 | return YES; | ||
| 8800 | } | ||
| 8801 | |||
| 8696 | #ifdef NS_IMPL_COCOA | 8802 | #ifdef NS_IMPL_COCOA |
| 8697 | - (id)accessibilityAttributeValue:(NSString *)attribute | 8803 | - (id)accessibilityAttributeValue:(NSString *)attribute |
| 8698 | { | 8804 | { |
diff --git a/src/pdumper.c b/src/pdumper.c index 6956ee36829..116cc28dbba 100644 --- a/src/pdumper.c +++ b/src/pdumper.c | |||
| @@ -2058,7 +2058,7 @@ dump_interval_tree (struct dump_context *ctx, | |||
| 2058 | static dump_off | 2058 | static dump_off |
| 2059 | dump_string (struct dump_context *ctx, const struct Lisp_String *string) | 2059 | dump_string (struct dump_context *ctx, const struct Lisp_String *string) |
| 2060 | { | 2060 | { |
| 2061 | #if CHECK_STRUCTS && !defined (HASH_Lisp_String_86FEA6EC7C) | 2061 | #if CHECK_STRUCTS && !defined (HASH_Lisp_String_348C2B2FDB) |
| 2062 | # error "Lisp_String changed. See CHECK_STRUCTS comment in config.h." | 2062 | # error "Lisp_String changed. See CHECK_STRUCTS comment in config.h." |
| 2063 | #endif | 2063 | #endif |
| 2064 | /* If we have text properties, write them _after_ the string so that | 2064 | /* If we have text properties, write them _after_ the string so that |
diff --git a/src/print.c b/src/print.c index 94a8bcbf882..14af9195475 100644 --- a/src/print.c +++ b/src/print.c | |||
| @@ -1557,7 +1557,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, | |||
| 1557 | /* Implement a readable output, e.g.: | 1557 | /* Implement a readable output, e.g.: |
| 1558 | #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ | 1558 | #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ |
| 1559 | /* Always print the size. */ | 1559 | /* Always print the size. */ |
| 1560 | int len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next)); | 1560 | int len = sprintf (buf, "#s(hash-table size %"pD"d", |
| 1561 | HASH_TABLE_SIZE (h)); | ||
| 1561 | strout (buf, len, len, printcharfun); | 1562 | strout (buf, len, len, printcharfun); |
| 1562 | 1563 | ||
| 1563 | if (!NILP (h->test.name)) | 1564 | if (!NILP (h->test.name)) |
diff --git a/src/process.c b/src/process.c index 3550f623c6a..25883f911f1 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -692,8 +692,7 @@ status_convert (int w) | |||
| 692 | if (WIFSTOPPED (w)) | 692 | if (WIFSTOPPED (w)) |
| 693 | return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil)); | 693 | return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil)); |
| 694 | else if (WIFEXITED (w)) | 694 | else if (WIFEXITED (w)) |
| 695 | return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), | 695 | return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), Qnil)); |
| 696 | WCOREDUMP (w) ? Qt : Qnil)); | ||
| 697 | else if (WIFSIGNALED (w)) | 696 | else if (WIFSIGNALED (w)) |
| 698 | return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)), | 697 | return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)), |
| 699 | WCOREDUMP (w) ? Qt : Qnil)); | 698 | WCOREDUMP (w) ? Qt : Qnil)); |
| @@ -2059,6 +2058,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) | |||
| 2059 | bool pty_flag = 0; | 2058 | bool pty_flag = 0; |
| 2060 | char pty_name[PTY_NAME_SIZE]; | 2059 | char pty_name[PTY_NAME_SIZE]; |
| 2061 | Lisp_Object lisp_pty_name = Qnil; | 2060 | Lisp_Object lisp_pty_name = Qnil; |
| 2061 | sigset_t oldset; | ||
| 2062 | 2062 | ||
| 2063 | inchannel = outchannel = -1; | 2063 | inchannel = outchannel = -1; |
| 2064 | 2064 | ||
| @@ -2139,13 +2139,16 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) | |||
| 2139 | setup_process_coding_systems (process); | 2139 | setup_process_coding_systems (process); |
| 2140 | char **env = make_environment_block (current_dir); | 2140 | char **env = make_environment_block (current_dir); |
| 2141 | 2141 | ||
| 2142 | block_input (); | ||
| 2143 | block_child_signal (&oldset); | ||
| 2144 | |||
| 2142 | pty_flag = p->pty_flag; | 2145 | pty_flag = p->pty_flag; |
| 2143 | eassert (pty_flag == ! NILP (lisp_pty_name)); | 2146 | eassert (pty_flag == ! NILP (lisp_pty_name)); |
| 2144 | 2147 | ||
| 2145 | vfork_errno | 2148 | vfork_errno |
| 2146 | = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env, | 2149 | = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env, |
| 2147 | SSDATA (current_dir), | 2150 | SSDATA (current_dir), |
| 2148 | pty_flag ? SSDATA (lisp_pty_name) : NULL); | 2151 | pty_flag ? SSDATA (lisp_pty_name) : NULL, &oldset); |
| 2149 | 2152 | ||
| 2150 | eassert ((vfork_errno == 0) == (0 < pid)); | 2153 | eassert ((vfork_errno == 0) == (0 < pid)); |
| 2151 | 2154 | ||
| @@ -2153,6 +2156,10 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) | |||
| 2153 | if (pid >= 0) | 2156 | if (pid >= 0) |
| 2154 | p->alive = 1; | 2157 | p->alive = 1; |
| 2155 | 2158 | ||
| 2159 | /* Stop blocking in the parent. */ | ||
| 2160 | unblock_child_signal (&oldset); | ||
| 2161 | unblock_input (); | ||
| 2162 | |||
| 2156 | /* Environment block no longer needed. */ | 2163 | /* Environment block no longer needed. */ |
| 2157 | unbind_to (count, Qnil); | 2164 | unbind_to (count, Qnil); |
| 2158 | 2165 | ||
diff --git a/src/terminfo.c b/src/terminfo.c index 15aff317f15..a9c9572bbb2 100644 --- a/src/terminfo.c +++ b/src/terminfo.c | |||
| @@ -23,10 +23,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 23 | 23 | ||
| 24 | /* Define these variables that serve as global parameters to termcap, | 24 | /* Define these variables that serve as global parameters to termcap, |
| 25 | so that we do not need to conditionalize the places in Emacs | 25 | so that we do not need to conditionalize the places in Emacs |
| 26 | that set them. But don't do that for terminfo, as that could | 26 | that set them. But don't do that if terminfo defines them, as that |
| 27 | cause link errors when using -fno-common. */ | 27 | could cause link errors when using -fno-common. */ |
| 28 | 28 | ||
| 29 | #if !TERMINFO | 29 | #ifndef TERMINFO_DEFINES_BC |
| 30 | char *UP, *BC, PC; | 30 | char *UP, *BC, PC; |
| 31 | #endif | 31 | #endif |
| 32 | 32 | ||
diff --git a/src/window.c b/src/window.c index ba8682eed7c..5e78aa400b5 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -8100,6 +8100,18 @@ and scrolling positions. */) | |||
| 8100 | return Qt; | 8100 | return Qt; |
| 8101 | return Qnil; | 8101 | return Qnil; |
| 8102 | } | 8102 | } |
| 8103 | |||
| 8104 | DEFUN ("window-bump-use-time", Fwindow_bump_use_time, | ||
| 8105 | Swindow_bump_use_time, 1, 1, 0, | ||
| 8106 | doc: /* Mark WINDOW as having been recently used. */) | ||
| 8107 | (Lisp_Object window) | ||
| 8108 | { | ||
| 8109 | struct window *w = decode_valid_window (window); | ||
| 8110 | |||
| 8111 | w->use_time = ++window_select_count; | ||
| 8112 | return Qnil; | ||
| 8113 | } | ||
| 8114 | |||
| 8103 | 8115 | ||
| 8104 | 8116 | ||
| 8105 | static void init_window_once_for_pdumper (void); | 8117 | static void init_window_once_for_pdumper (void); |
| @@ -8573,6 +8585,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */); | |||
| 8573 | defsubr (&Swindow_vscroll); | 8585 | defsubr (&Swindow_vscroll); |
| 8574 | defsubr (&Sset_window_vscroll); | 8586 | defsubr (&Sset_window_vscroll); |
| 8575 | defsubr (&Scompare_window_configurations); | 8587 | defsubr (&Scompare_window_configurations); |
| 8588 | defsubr (&Swindow_bump_use_time); | ||
| 8576 | defsubr (&Swindow_list); | 8589 | defsubr (&Swindow_list); |
| 8577 | defsubr (&Swindow_list_1); | 8590 | defsubr (&Swindow_list_1); |
| 8578 | defsubr (&Swindow_prev_buffers); | 8591 | defsubr (&Swindow_prev_buffers); |
| @@ -8583,14 +8596,3 @@ displayed after a scrolling operation to be somewhat inaccurate. */); | |||
| 8583 | defsubr (&Swindow_parameter); | 8596 | defsubr (&Swindow_parameter); |
| 8584 | defsubr (&Sset_window_parameter); | 8597 | defsubr (&Sset_window_parameter); |
| 8585 | } | 8598 | } |
| 8586 | |||
| 8587 | void | ||
| 8588 | keys_of_window (void) | ||
| 8589 | { | ||
| 8590 | initial_define_key (control_x_map, '<', "scroll-left"); | ||
| 8591 | initial_define_key (control_x_map, '>', "scroll-right"); | ||
| 8592 | |||
| 8593 | initial_define_key (global_map, Ctl ('V'), "scroll-up-command"); | ||
| 8594 | initial_define_key (meta_map, Ctl ('V'), "scroll-other-window"); | ||
| 8595 | initial_define_key (meta_map, 'v', "scroll-down-command"); | ||
| 8596 | } | ||
diff --git a/src/window.h b/src/window.h index fba98f438c4..fbdec0df997 100644 --- a/src/window.h +++ b/src/window.h | |||
| @@ -1202,7 +1202,6 @@ extern bool window_outdated (struct window *); | |||
| 1202 | extern void init_window_once (void); | 1202 | extern void init_window_once (void); |
| 1203 | extern void init_window (void); | 1203 | extern void init_window (void); |
| 1204 | extern void syms_of_window (void); | 1204 | extern void syms_of_window (void); |
| 1205 | extern void keys_of_window (void); | ||
| 1206 | /* Move cursor to row/column position VPOS/HPOS, pixel coordinates | 1205 | /* Move cursor to row/column position VPOS/HPOS, pixel coordinates |
| 1207 | Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y | 1206 | Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y |
| 1208 | are window-relative pixel positions. This is always done during | 1207 | are window-relative pixel positions. This is always done during |
diff --git a/src/xdisp.c b/src/xdisp.c index b0f218dcb35..d070c5ae5cd 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -4262,6 +4262,7 @@ handle_fontified_prop (struct it *it) | |||
| 4262 | if (!STRINGP (it->string) | 4262 | if (!STRINGP (it->string) |
| 4263 | && it->s == NULL | 4263 | && it->s == NULL |
| 4264 | && !NILP (Vfontification_functions) | 4264 | && !NILP (Vfontification_functions) |
| 4265 | && !(input_was_pending && redisplay_skip_fontification_on_input) | ||
| 4265 | && !NILP (Vrun_hooks) | 4266 | && !NILP (Vrun_hooks) |
| 4266 | && (pos = make_fixnum (IT_CHARPOS (*it)), | 4267 | && (pos = make_fixnum (IT_CHARPOS (*it)), |
| 4267 | prop = Fget_char_property (pos, Qfontified, Qnil), | 4268 | prop = Fget_char_property (pos, Qfontified, Qnil), |
| @@ -25508,7 +25509,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) | |||
| 25508 | if (start < i) | 25509 | if (start < i) |
| 25509 | display_string (NULL, | 25510 | display_string (NULL, |
| 25510 | Fsubstring (mode_string, make_fixnum (start), | 25511 | Fsubstring (mode_string, make_fixnum (start), |
| 25511 | make_fixnum (i - 1)), | 25512 | make_fixnum (i)), |
| 25512 | Qnil, 0, 0, &it, 0, 0, 0, | 25513 | Qnil, 0, 0, &it, 0, 0, 0, |
| 25513 | STRING_MULTIBYTE (mode_string)); | 25514 | STRING_MULTIBYTE (mode_string)); |
| 25514 | } | 25515 | } |
| @@ -35613,6 +35614,19 @@ best except in special circumstances such as running redisplay tests | |||
| 35613 | in batch mode. */); | 35614 | in batch mode. */); |
| 35614 | redisplay_skip_initial_frame = true; | 35615 | redisplay_skip_initial_frame = true; |
| 35615 | 35616 | ||
| 35617 | DEFVAR_BOOL ("redisplay-skip-fontification-on-input", | ||
| 35618 | redisplay_skip_fontification_on_input, | ||
| 35619 | doc: /* Skip `fontification_functions` when there is input pending. | ||
| 35620 | If non-nil and there was input pending at the beginning of the command, | ||
| 35621 | the `fontification_functions` hook is not run. This usually does not | ||
| 35622 | affect the display because redisplay is completely skipped anyway if input | ||
| 35623 | was pending, but it can make scrolling smoother by avoiding | ||
| 35624 | unnecessary fontification. | ||
| 35625 | It is similar to `fast-but-imprecise-scrolling' with similar tradeoffs, | ||
| 35626 | but with the advantage that it should only affect the behavior when Emacs | ||
| 35627 | has trouble keeping up with the incoming input rate. */); | ||
| 35628 | redisplay_skip_fontification_on_input = false; | ||
| 35629 | |||
| 35616 | DEFVAR_BOOL ("redisplay-adhoc-scroll-in-resize-mini-windows", | 35630 | DEFVAR_BOOL ("redisplay-adhoc-scroll-in-resize-mini-windows", |
| 35617 | redisplay_adhoc_scroll_in_resize_mini_windows, | 35631 | redisplay_adhoc_scroll_in_resize_mini_windows, |
| 35618 | doc: /* If nil always use normal scrolling in minibuffer windows. | 35632 | doc: /* If nil always use normal scrolling in minibuffer windows. |
diff --git a/src/xterm.c b/src/xterm.c index 0a86738cc20..b8374fed8b1 100644 --- a/src/xterm.c +++ b/src/xterm.c | |||
| @@ -13035,13 +13035,13 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) | |||
| 13035 | or larger than other for other applications, even if it is the same | 13035 | or larger than other for other applications, even if it is the same |
| 13036 | font name (monospace-10 for example). */ | 13036 | font name (monospace-10 for example). */ |
| 13037 | 13037 | ||
| 13038 | # ifdef HAVE_XRENDER | ||
| 13038 | int event_base, error_base; | 13039 | int event_base, error_base; |
| 13039 | char *v; | ||
| 13040 | double d; | ||
| 13041 | |||
| 13042 | XRenderQueryExtension (dpyinfo->display, &event_base, &error_base); | 13040 | XRenderQueryExtension (dpyinfo->display, &event_base, &error_base); |
| 13041 | # endif | ||
| 13043 | 13042 | ||
| 13044 | v = XGetDefault (dpyinfo->display, "Xft", "dpi"); | 13043 | char *v = XGetDefault (dpyinfo->display, "Xft", "dpi"); |
| 13044 | double d; | ||
| 13045 | if (v != NULL && sscanf (v, "%lf", &d) == 1) | 13045 | if (v != NULL && sscanf (v, "%lf", &d) == 1) |
| 13046 | dpyinfo->resy = dpyinfo->resx = d; | 13046 | dpyinfo->resy = dpyinfo->resx = d; |
| 13047 | } | 13047 | } |
diff --git a/test/Makefile.in b/test/Makefile.in index 8aa37ca7854..fc40dad5e2e 100644 --- a/test/Makefile.in +++ b/test/Makefile.in | |||
| @@ -161,11 +161,15 @@ endif | |||
| 161 | 161 | ||
| 162 | ## Save logs, and show logs for failed tests. | 162 | ## Save logs, and show logs for failed tests. |
| 163 | WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } | 163 | WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } |
| 164 | ## On Hydra or Emba, always show logs for certain problematic tests. | ||
| 164 | ifdef EMACS_HYDRA_CI | 165 | ifdef EMACS_HYDRA_CI |
| 165 | ## On Hydra, always show logs for certain problematic tests. | ||
| 166 | lisp/net/tramp-tests.log \ | 166 | lisp/net/tramp-tests.log \ |
| 167 | : WRITE_LOG = 2>&1 | tee $@ | 167 | : WRITE_LOG = 2>&1 | tee $@ |
| 168 | endif | 168 | endif |
| 169 | ifdef EMACS_EMBA_CI | ||
| 170 | lisp/filenotify-tests.log lisp/net/tramp-tests.log \ | ||
| 171 | : WRITE_LOG = 2>&1 | tee $@ | ||
| 172 | endif | ||
| 169 | 173 | ||
| 170 | ifeq ($(TEST_LOAD_EL), yes) | 174 | ifeq ($(TEST_LOAD_EL), yes) |
| 171 | testloadfile = $*.el | 175 | testloadfile = $*.el |
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el new file mode 100644 index 00000000000..e65a541e6e3 --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el | |||
| @@ -0,0 +1,7 @@ | |||
| 1 | ;;; -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | (make-obsolete-variable 'bytecomp--tests-obsolete-var-2 nil "99.99") | ||
| 4 | |||
| 5 | (defun foo () | ||
| 6 | (let ((bytecomp--tests-obsolete-var-2 2)) | ||
| 7 | bytecomp--tests-obsolete-var-2)) | ||
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 5e5f99dbdab..a07af188fac 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el | |||
| @@ -625,6 +625,9 @@ Subtests signal errors if something goes wrong." | |||
| 625 | (bytecomp--define-warning-file-test "warn-obsolete-variable.el" | 625 | (bytecomp--define-warning-file-test "warn-obsolete-variable.el" |
| 626 | "bytecomp--tests-obs.*obsolete.*99.99") | 626 | "bytecomp--tests-obs.*obsolete.*99.99") |
| 627 | 627 | ||
| 628 | (bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el" | ||
| 629 | "bytecomp--tests-obs.*obsolete.*99.99" t) | ||
| 630 | |||
| 628 | (bytecomp--define-warning-file-test "warn-redefine-defun-as-macro.el" | 631 | (bytecomp--define-warning-file-test "warn-redefine-defun-as-macro.el" |
| 629 | "as both function and macro") | 632 | "as both function and macro") |
| 630 | 633 | ||
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 446983c2e3e..bcd63f73a3c 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el | |||
| @@ -610,4 +610,27 @@ collection clause." | |||
| 610 | ;; Just make sure the function can be instrumented. | 610 | ;; Just make sure the function can be instrumented. |
| 611 | (edebug-defun))) | 611 | (edebug-defun))) |
| 612 | 612 | ||
| 613 | ;;; cl-labels | ||
| 614 | |||
| 615 | (ert-deftest cl-macs--labels () | ||
| 616 | ;; Simple recursive function. | ||
| 617 | (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0))) | ||
| 618 | (should (equal (len (make-list 42 t)) 42))) | ||
| 619 | |||
| 620 | ;; Simple tail-recursive function. | ||
| 621 | (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n))) | ||
| 622 | (should (equal (len (make-list 42 t) 0) 42)) | ||
| 623 | ;; Should not bump into stack depth limits. | ||
| 624 | (should (equal (len (make-list 42000 t) 0) 42000))) | ||
| 625 | |||
| 626 | ;; Check that non-recursive functions are handled more efficiently. | ||
| 627 | (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) | ||
| 628 | (`(let* ,_ (funcall ,_ 5)) t))) | ||
| 629 | |||
| 630 | ;; Case of "tail-recursive lambdas". | ||
| 631 | (should (pcase (macroexpand | ||
| 632 | '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n))) | ||
| 633 | #'len)) | ||
| 634 | (`(function (lambda (,_ ,_) . ,_)) t)))) | ||
| 635 | |||
| 613 | ;;; cl-macs-tests.el ends here | 636 | ;;; cl-macs-tests.el ends here |
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 047109a96a2..d73b072661a 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el | |||
| @@ -1265,7 +1265,7 @@ delivered." | |||
| 1265 | ;; Unpredictable failures, eg https://hydra.nixos.org/build/86016286 | 1265 | ;; Unpredictable failures, eg https://hydra.nixos.org/build/86016286 |
| 1266 | (file-notify--deftest-remote file-notify-test07-many-events | 1266 | (file-notify--deftest-remote file-notify-test07-many-events |
| 1267 | "Check that events are not dropped for remote directories." | 1267 | "Check that events are not dropped for remote directories." |
| 1268 | (getenv "EMACS_HYDRA_CI")) | 1268 | (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))) |
| 1269 | 1269 | ||
| 1270 | (ert-deftest file-notify-test08-backup () | 1270 | (ert-deftest file-notify-test08-backup () |
| 1271 | "Check that backup keeps file notification." | 1271 | "Check that backup keeps file notification." |
diff --git a/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin new file mode 100644 index 00000000000..0b193a27234 --- /dev/null +++ b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin | |||
| @@ -0,0 +1,20 @@ | |||
| 1 | From: example <example@example.org> | ||
| 2 | To: example <example@example.org> | ||
| 3 | Content-Type: multipart/alternative; boundary="===============2877195075946974246==" | ||
| 4 | Date: Thu, 29 Oct 2020 14:47:55 +0100 | ||
| 5 | MIME-Version: 1.0 | ||
| 6 | Subject: test | ||
| 7 | |||
| 8 | --===============2877195075946974246== | ||
| 9 | Content-Type: text/plain; charset="utf-8" | ||
| 10 | Content-Transfer-Encoding: 8bit | ||
| 11 | |||
| 12 | ääää | ||
| 13 | |||
| 14 | --===============2877195075946974246== | ||
| 15 | Content-Type: text/html; charset="utf-8" | ||
| 16 | Content-Transfer-Encoding: 8bit | ||
| 17 | |||
| 18 | <!doctype html><html><head><meta http-equiv="content-type" content="text/html; charset=UTF-8"></head><body>ääää</body></html> | ||
| 19 | |||
| 20 | --===============2877195075946974246==-- | ||
diff --git a/test/lisp/gnus/mm-decode-tests.el b/test/lisp/gnus/mm-decode-tests.el new file mode 100644 index 00000000000..74591f919da --- /dev/null +++ b/test/lisp/gnus/mm-decode-tests.el | |||
| @@ -0,0 +1,89 @@ | |||
| 1 | ;;; mm-decode-tests.el --- -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2021 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 10 | ;; any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 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/>. | ||
| 19 | |||
| 20 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;;; Code: | ||
| 23 | |||
| 24 | (require 'ert) | ||
| 25 | (require 'ert-x) | ||
| 26 | (require 'mm-decode) | ||
| 27 | |||
| 28 | (ert-deftest test-mm-dissect-buffer () | ||
| 29 | (with-temp-buffer | ||
| 30 | (set-buffer-multibyte nil) | ||
| 31 | (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin")) | ||
| 32 | (while (search-forward "\r\n" nil t) | ||
| 33 | (replace-match "\n")) | ||
| 34 | (let ((handle (mm-dissect-buffer))) | ||
| 35 | (should (equal (mm-handle-media-type handle) "multipart/alternative")) | ||
| 36 | ;; Skip multipart type. | ||
| 37 | (pop handle) | ||
| 38 | (let ((part (pop handle))) | ||
| 39 | (should (equal (mm-handle-media-type part) "text/plain")) | ||
| 40 | (should (eq (mm-handle-encoding part) '8bit)) | ||
| 41 | (with-current-buffer (mm-handle-buffer part) | ||
| 42 | (should (equal (decode-coding-string | ||
| 43 | (buffer-string) | ||
| 44 | (intern (mail-content-type-get (mm-handle-type part) | ||
| 45 | 'charset))) | ||
| 46 | "ääää\n")))) | ||
| 47 | (let ((part (pop handle))) | ||
| 48 | (should (equal (mm-handle-media-type part) "text/html")) | ||
| 49 | (should (eq (mm-handle-encoding part) '8bit)) | ||
| 50 | (with-current-buffer (mm-handle-buffer part) | ||
| 51 | (should (equal (decode-coding-string | ||
| 52 | (buffer-string) | ||
| 53 | (intern (mail-content-type-get (mm-handle-type part) | ||
| 54 | 'charset))) | ||
| 55 | "<!doctype html><html><head><meta http-equiv=\"content-type\" content=\"text/html; charset=UTF-8\"></head><body>ääää</body></html>\n"))))))) | ||
| 56 | |||
| 57 | (ert-deftest test-mm-with-part-unibyte () | ||
| 58 | (with-temp-buffer | ||
| 59 | (set-buffer-multibyte nil) | ||
| 60 | (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin")) | ||
| 61 | (while (search-forward "\r\n" nil t) | ||
| 62 | (replace-match "\n")) | ||
| 63 | (let ((handle (mm-dissect-buffer))) | ||
| 64 | (pop handle) | ||
| 65 | (let ((part (pop handle))) | ||
| 66 | (should (equal (decode-coding-string | ||
| 67 | (mm-with-part part | ||
| 68 | (buffer-string)) | ||
| 69 | (intern (mail-content-type-get (mm-handle-type part) | ||
| 70 | 'charset))) | ||
| 71 | "ääää\n")))))) | ||
| 72 | |||
| 73 | (ert-deftest test-mm-with-part-multibyte () | ||
| 74 | (with-temp-buffer | ||
| 75 | (set-buffer-multibyte t) | ||
| 76 | (nnheader-insert-file-contents (ert-resource-file "8bit-multipart.bin")) | ||
| 77 | (while (search-forward "\r\n" nil t) | ||
| 78 | (replace-match "\n")) | ||
| 79 | (let ((handle (mm-dissect-buffer))) | ||
| 80 | (pop handle) | ||
| 81 | (let ((part (pop handle))) | ||
| 82 | (should (equal (decode-coding-string | ||
| 83 | (mm-with-part part | ||
| 84 | (buffer-string)) | ||
| 85 | (intern (mail-content-type-get (mm-handle-type part) | ||
| 86 | 'charset))) | ||
| 87 | "ääää\n")))))) | ||
| 88 | |||
| 89 | ;;; mm-decode-tests.el ends here | ||
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 95557c95eb7..835d9fe7949 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el | |||
| @@ -102,7 +102,7 @@ RET minibuffer-complete-and-exit | |||
| 102 | ESC Prefix Command | 102 | ESC Prefix Command |
| 103 | SPC minibuffer-complete-word | 103 | SPC minibuffer-complete-word |
| 104 | ? minibuffer-completion-help | 104 | ? minibuffer-completion-help |
| 105 | <C-tab> file-cache-minibuffer-complete | 105 | C-<tab> file-cache-minibuffer-complete |
| 106 | <XF86Back> previous-history-element | 106 | <XF86Back> previous-history-element |
| 107 | <XF86Forward> next-history-element | 107 | <XF86Forward> next-history-element |
| 108 | <down> next-line-or-history-element | 108 | <down> next-line-or-history-element |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 896b9978e7c..e1cb9939f29 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -4670,7 +4670,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." | |||
| 4670 | 4670 | ||
| 4671 | (ert-deftest tramp-test31-interrupt-process () | 4671 | (ert-deftest tramp-test31-interrupt-process () |
| 4672 | "Check `interrupt-process'." | 4672 | "Check `interrupt-process'." |
| 4673 | :tags (if (getenv "EMACS_EMBA_CI") | 4673 | :tags (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) |
| 4674 | '(:expensive-test :unstable) '(:expensive-test)) | 4674 | '(:expensive-test :unstable) '(:expensive-test)) |
| 4675 | (skip-unless (tramp--test-enabled)) | 4675 | (skip-unless (tramp--test-enabled)) |
| 4676 | (skip-unless (tramp--test-sh-p)) | 4676 | (skip-unless (tramp--test-sh-p)) |
| @@ -5787,7 +5787,8 @@ This requires restrictions of file name syntax." | |||
| 5787 | (tmp-name2 (tramp--test-make-temp-name 'local quoted)) | 5787 | (tmp-name2 (tramp--test-make-temp-name 'local quoted)) |
| 5788 | (files (delq nil files)) | 5788 | (files (delq nil files)) |
| 5789 | (process-environment process-environment) | 5789 | (process-environment process-environment) |
| 5790 | (sorted-files (sort (copy-sequence files) #'string-lessp))) | 5790 | (sorted-files (sort (copy-sequence files) #'string-lessp)) |
| 5791 | buffer) | ||
| 5791 | (unwind-protect | 5792 | (unwind-protect |
| 5792 | (progn | 5793 | (progn |
| 5793 | (make-directory tmp-name1) | 5794 | (make-directory tmp-name1) |
| @@ -5849,6 +5850,18 @@ This requires restrictions of file name syntax." | |||
| 5849 | tmp-name2 nil directory-files-no-dot-files-regexp)) | 5850 | tmp-name2 nil directory-files-no-dot-files-regexp)) |
| 5850 | sorted-files)) | 5851 | sorted-files)) |
| 5851 | 5852 | ||
| 5853 | ;; Check, that `insert-directory' works properly. | ||
| 5854 | (with-current-buffer | ||
| 5855 | (setq buffer (dired-noselect tmp-name1 "--dired -al")) | ||
| 5856 | (goto-char (point-min)) | ||
| 5857 | (while (not (eobp)) | ||
| 5858 | (when-let ((name (dired-get-filename 'localp 'no-error))) | ||
| 5859 | (unless | ||
| 5860 | (string-match-p name directory-files-no-dot-files-regexp) | ||
| 5861 | (should (member name files)))) | ||
| 5862 | (forward-line 1))) | ||
| 5863 | (kill-buffer buffer) | ||
| 5864 | |||
| 5852 | ;; `substitute-in-file-name' could return different | 5865 | ;; `substitute-in-file-name' could return different |
| 5853 | ;; values. For `adb', there could be strange file | 5866 | ;; values. For `adb', there could be strange file |
| 5854 | ;; permissions preventing overwriting a file. We don't | 5867 | ;; permissions preventing overwriting a file. We don't |
| @@ -5944,6 +5957,7 @@ This requires restrictions of file name syntax." | |||
| 5944 | (regexp-quote (getenv envvar)))))))))) | 5957 | (regexp-quote (getenv envvar)))))))))) |
| 5945 | 5958 | ||
| 5946 | ;; Cleanup. | 5959 | ;; Cleanup. |
| 5960 | (ignore-errors (kill-buffer buffer)) | ||
| 5947 | (ignore-errors (delete-directory tmp-name1 'recursive)) | 5961 | (ignore-errors (delete-directory tmp-name1 'recursive)) |
| 5948 | (ignore-errors (delete-directory tmp-name2 'recursive)))))) | 5962 | (ignore-errors (delete-directory tmp-name2 'recursive)))))) |
| 5949 | 5963 | ||
diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl new file mode 100644 index 00000000000..8af4625fff3 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl | |||
| @@ -0,0 +1,143 @@ | |||
| 1 | use 5.020; | ||
| 2 | |||
| 3 | =head1 NAME | ||
| 4 | |||
| 5 | here-docs.pl - resource file for cperl-test-here-docs | ||
| 6 | |||
| 7 | =head1 DESCRIPTION | ||
| 8 | |||
| 9 | This file holds a couple of HERE documents, with a variety of normal | ||
| 10 | and edge cases. For a formatted view of this description, run: | ||
| 11 | |||
| 12 | (cperl-perldoc "here-docs.pl") | ||
| 13 | |||
| 14 | For each of the HERE documents, the following checks will done: | ||
| 15 | |||
| 16 | =over 4 | ||
| 17 | |||
| 18 | =item * | ||
| 19 | |||
| 20 | All occurrences of the string "look-here" are fontified correcty. | ||
| 21 | Note that we deliberately test the face, not the syntax property: | ||
| 22 | Users won't care for the syntax property, but they see the face. | ||
| 23 | Different implementations with different syntax properties have been | ||
| 24 | seen in the past. | ||
| 25 | |||
| 26 | =item * | ||
| 27 | |||
| 28 | Indentation of the line(s) containing "look-here" is 0, i.e. there are no | ||
| 29 | leading spaces. | ||
| 30 | |||
| 31 | =item * | ||
| 32 | |||
| 33 | Indentation of the following perl statement containing "indent" should | ||
| 34 | be 0 if the statement contains "noindent", and according to the mode's | ||
| 35 | continued-statement-offset otherwise. | ||
| 36 | |||
| 37 | =back | ||
| 38 | |||
| 39 | =cut | ||
| 40 | |||
| 41 | # Prologue to make the test file valid without warnings | ||
| 42 | |||
| 43 | my $text; | ||
| 44 | my $any; | ||
| 45 | my $indentation; | ||
| 46 | my $anywhere = 'back again'; | ||
| 47 | my $noindent; | ||
| 48 | |||
| 49 | =head1 The Tests | ||
| 50 | |||
| 51 | =head2 Test Case 1 | ||
| 52 | |||
| 53 | We have two HERE documents in one line with different quoting styles. | ||
| 54 | |||
| 55 | =cut | ||
| 56 | |||
| 57 | ## test case | ||
| 58 | |||
| 59 | $text = <<"HERE" . <<'THERE' . $any; | ||
| 60 | #look-here and | ||
| 61 | HERE | ||
| 62 | $tlook-here and | ||
| 63 | THERE | ||
| 64 | |||
| 65 | $noindent = "This should be left-justified"; | ||
| 66 | |||
| 67 | =head2 Test case 2 | ||
| 68 | |||
| 69 | A HERE document followed by a continuation line | ||
| 70 | |||
| 71 | =cut | ||
| 72 | |||
| 73 | ## test case | ||
| 74 | |||
| 75 | $text = <<HERE | ||
| 76 | look-here | ||
| 77 | HERE | ||
| 78 | |||
| 79 | . 'indent-level'; # Continuation, should be indented | ||
| 80 | |||
| 81 | =head2 Test case 3 | ||
| 82 | |||
| 83 | A here document with a line-end comment in the starter line, | ||
| 84 | after a complete statement | ||
| 85 | |||
| 86 | =cut | ||
| 87 | |||
| 88 | ## test case | ||
| 89 | |||
| 90 | $text = <<HERE; # start here | ||
| 91 | look-here | ||
| 92 | HERE | ||
| 93 | |||
| 94 | $noindent = "New statement in this line"; | ||
| 95 | |||
| 96 | =head2 Test case 4 | ||
| 97 | |||
| 98 | A HERE document with a to-be-continued statement and a comment in the | ||
| 99 | starter line. | ||
| 100 | |||
| 101 | =cut | ||
| 102 | |||
| 103 | ## test case | ||
| 104 | |||
| 105 | $text = <<HERE # start here | ||
| 106 | look-here | ||
| 107 | HERE | ||
| 108 | |||
| 109 | . 'indent-level'; # Continuation, should be indented | ||
| 110 | |||
| 111 | =head2 Test case 5 | ||
| 112 | |||
| 113 | A HERE document with a comment sign, but no comment to follow. | ||
| 114 | |||
| 115 | |||
| 116 | =cut | ||
| 117 | |||
| 118 | ## test case | ||
| 119 | |||
| 120 | $text = <<HERE; # | ||
| 121 | look-here | ||
| 122 | HERE | ||
| 123 | |||
| 124 | $noindent = "New statement in this line"; | ||
| 125 | |||
| 126 | =head2 Test case 6 | ||
| 127 | |||
| 128 | A HERE document with a comment sign, but no comment to follow, with a | ||
| 129 | statement to be continued. Also, the character before the comment | ||
| 130 | sign has a relevant syntax property (end of string in our case) which | ||
| 131 | must be preserved. | ||
| 132 | |||
| 133 | =cut | ||
| 134 | |||
| 135 | ## test case | ||
| 136 | |||
| 137 | $text = <<"HERE"# | ||
| 138 | look-here | ||
| 139 | HERE | ||
| 140 | |||
| 141 | . 'indent-level'; # Continuation, should be indented | ||
| 142 | |||
| 143 | __END__ | ||
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 46e687f14d0..943c454445c 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el | |||
| @@ -135,6 +135,37 @@ point in the distant past, and is still broken in perl-mode. " | |||
| 135 | (should (equal (nth 3 (syntax-ppss)) nil)) | 135 | (should (equal (nth 3 (syntax-ppss)) nil)) |
| 136 | (should (equal (nth 4 (syntax-ppss)) t)))))) | 136 | (should (equal (nth 4 (syntax-ppss)) t)))))) |
| 137 | 137 | ||
| 138 | (ert-deftest cperl-test-heredocs () | ||
| 139 | "Test that HERE-docs are fontified with the appropriate face." | ||
| 140 | (require 'perl-mode) | ||
| 141 | (let ((file (ert-resource-file "here-docs.pl")) | ||
| 142 | (cperl-continued-statement-offset perl-continued-statement-offset) | ||
| 143 | (target-font (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc | ||
| 144 | 'font-lock-string-face)) | ||
| 145 | (case-fold-search nil)) | ||
| 146 | (with-temp-buffer | ||
| 147 | (insert-file-contents file) | ||
| 148 | (goto-char (point-min)) | ||
| 149 | (funcall cperl-test-mode) | ||
| 150 | (indent-region (point-min) (point-max)) | ||
| 151 | (font-lock-ensure (point-min) (point-max)) | ||
| 152 | (while (search-forward "## test case" nil t) | ||
| 153 | (save-excursion | ||
| 154 | (while (search-forward "look-here" nil t) | ||
| 155 | (should (equal | ||
| 156 | (get-text-property (match-beginning 0) 'face) | ||
| 157 | target-font)) | ||
| 158 | (beginning-of-line) | ||
| 159 | (should (null (looking-at "[ \t]"))) | ||
| 160 | (forward-line 1))) | ||
| 161 | (should (re-search-forward | ||
| 162 | (concat "^\\([ \t]*\\)" ; the actual indentation amount | ||
| 163 | "\\([^ \t\n].*?\\)\\(no\\)?indent") | ||
| 164 | nil t)) | ||
| 165 | (should (equal (- (match-end 1) (match-beginning 1)) | ||
| 166 | (if (match-beginning 3) 0 | ||
| 167 | perl-indent-level))))))) | ||
| 168 | |||
| 138 | ;;; Tests for issues reported in the Bug Tracker | 169 | ;;; Tests for issues reported in the Bug Tracker |
| 139 | 170 | ||
| 140 | (defun cperl-test--run-bug-10483 () | 171 | (defun cperl-test--run-bug-10483 () |
| @@ -164,6 +195,7 @@ under timeout control." | |||
| 164 | (interactive) | 195 | (interactive) |
| 165 | (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out | 196 | (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out |
| 166 | (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen | 197 | (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen |
| 198 | (skip-unless (eq cperl-test-mode #'cperl-mode)) | ||
| 167 | (let* ((emacs (concat invocation-directory invocation-name)) | 199 | (let* ((emacs (concat invocation-directory invocation-name)) |
| 168 | (test-function 'cperl-test--run-bug-10483) | 200 | (test-function 'cperl-test--run-bug-10483) |
| 169 | (test-function-name (symbol-name test-function)) | 201 | (test-function-name (symbol-name test-function)) |
diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el index 67b592e9070..42a011c8bcd 100644 --- a/test/lisp/progmodes/ruby-mode-tests.el +++ b/test/lisp/progmodes/ruby-mode-tests.el | |||
| @@ -497,7 +497,8 @@ VALUES-PLIST is a list with alternating index and value elements." | |||
| 497 | (ert-deftest ruby-add-log-current-method-examples () | 497 | (ert-deftest ruby-add-log-current-method-examples () |
| 498 | (let ((pairs '(("foo" . "#foo") | 498 | (let ((pairs '(("foo" . "#foo") |
| 499 | ("C.foo" . ".foo") | 499 | ("C.foo" . ".foo") |
| 500 | ("self.foo" . ".foo")))) | 500 | ("self.foo" . ".foo") |
| 501 | ("<<" . "#<<")))) | ||
| 501 | (dolist (pair pairs) | 502 | (dolist (pair pairs) |
| 502 | (let ((name (car pair)) | 503 | (let ((name (car pair)) |
| 503 | (value (cdr pair))) | 504 | (value (cdr pair))) |
diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index eaafc5888c7..b4b5e4db5d6 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el | |||
| @@ -99,13 +99,18 @@ | |||
| 99 | (should (null (marker-position (cdr (nth 0 (cdr cons2)))))))) | 99 | (should (null (marker-position (cdr (nth 0 (cdr cons2)))))))) |
| 100 | 100 | ||
| 101 | (ert-deftest xref--xref-file-name-display-is-abs () | 101 | (ert-deftest xref--xref-file-name-display-is-abs () |
| 102 | (let ((xref-file-name-display 'abs)) | 102 | (let ((xref-file-name-display 'abs) |
| 103 | (should (equal (delete-dups | 103 | ;; Some older BSD find versions can produce '//' in the output. |
| 104 | (mapcar 'xref-location-group | 104 | (expected (list |
| 105 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) | 105 | (concat xref-tests--data-dir "/?file1.txt") |
| 106 | (list | 106 | (concat xref-tests--data-dir "/?file2.txt"))) |
| 107 | (concat xref-tests--data-dir "file1.txt") | 107 | (actual (delete-dups |
| 108 | (concat xref-tests--data-dir "file2.txt")))))) | 108 | (mapcar 'xref-location-group |
| 109 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))))) | ||
| 110 | (should (and (= (length expected) (length actual)) | ||
| 111 | (cl-every (lambda (e1 e2) | ||
| 112 | (string-match-p e1 e2)) | ||
| 113 | expected actual))))) | ||
| 109 | 114 | ||
| 110 | (ert-deftest xref--xref-file-name-display-is-nondirectory () | 115 | (ert-deftest xref--xref-file-name-display-is-nondirectory () |
| 111 | (let ((xref-file-name-display 'nondirectory)) | 116 | (let ((xref-file-name-display 'nondirectory)) |
| @@ -121,10 +126,15 @@ | |||
| 121 | (file-name-directory (directory-file-name xref-tests--data-dir))) | 126 | (file-name-directory (directory-file-name xref-tests--data-dir))) |
| 122 | (project-find-functions | 127 | (project-find-functions |
| 123 | #'(lambda (_) (cons 'transient data-parent-dir))) | 128 | #'(lambda (_) (cons 'transient data-parent-dir))) |
| 124 | (xref-file-name-display 'project-relative)) | 129 | (xref-file-name-display 'project-relative) |
| 125 | (should (equal (delete-dups | 130 | ;; Some older BSD find versions can produce '//' in the output. |
| 126 | (mapcar 'xref-location-group | 131 | (expected (list |
| 127 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) | 132 | "xref-resources//?file1.txt" |
| 128 | (list | 133 | "xref-resources//?file2.txt")) |
| 129 | "xref-resources/file1.txt" | 134 | (actual (delete-dups |
| 130 | "xref-resources/file2.txt"))))) | 135 | (mapcar 'xref-location-group |
| 136 | (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))))) | ||
| 137 | (should (and (= (length expected) (length actual)) | ||
| 138 | (cl-every (lambda (e1 e2) | ||
| 139 | (string-match-p e1 e2)) | ||
| 140 | expected actual))))) | ||
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 2f5b38d05d9..e0826208b60 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el | |||
| @@ -61,6 +61,35 @@ | |||
| 61 | (quote | 61 | (quote |
| 62 | (0 font-lock-keyword-face)))))))) | 62 | (0 font-lock-keyword-face)))))))) |
| 63 | 63 | ||
| 64 | |||
| 65 | ;;;; Keymap support. | ||
| 66 | |||
| 67 | (ert-deftest subr-test-kbd () | ||
| 68 | (should (equal (kbd "f") "f")) | ||
| 69 | (should (equal (kbd "<f1>") [f1])) | ||
| 70 | (should (equal (kbd "RET") "\C-m")) | ||
| 71 | (should (equal (kbd "C-x a") "\C-xa")) | ||
| 72 | ;; Check that kbd handles both new and old style key descriptions | ||
| 73 | ;; (bug#45536). | ||
| 74 | (should (equal (kbd "s-<return>") [s-return])) | ||
| 75 | (should (equal (kbd "<s-return>") [s-return])) | ||
| 76 | (should (equal (kbd "C-M-<return>") [C-M-return])) | ||
| 77 | (should (equal (kbd "<C-M-return>") [C-M-return]))) | ||
| 78 | |||
| 79 | (ert-deftest subr-test-define-prefix-command () | ||
| 80 | (define-prefix-command 'foo-prefix-map) | ||
| 81 | (should (keymapp foo-prefix-map)) | ||
| 82 | (should (fboundp #'foo-prefix-map)) | ||
| 83 | ;; With optional argument. | ||
| 84 | (define-prefix-command 'bar-prefix 'bar-prefix-map) | ||
| 85 | (should (keymapp bar-prefix-map)) | ||
| 86 | (should (fboundp #'bar-prefix)) | ||
| 87 | ;; Returns the symbol. | ||
| 88 | (should (eq (define-prefix-command 'foo-bar) 'foo-bar))) | ||
| 89 | |||
| 90 | |||
| 91 | ;;;; Mode hooks. | ||
| 92 | |||
| 64 | (defalias 'subr-tests--parent-mode | 93 | (defalias 'subr-tests--parent-mode |
| 65 | (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) | 94 | (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) |
| 66 | 95 | ||
| @@ -404,6 +433,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." | |||
| 404 | (should (equal (flatten-tree '(1 ("foo" "bar") 2)) | 433 | (should (equal (flatten-tree '(1 ("foo" "bar") 2)) |
| 405 | '(1 "foo" "bar" 2)))) | 434 | '(1 "foo" "bar" 2)))) |
| 406 | 435 | ||
| 436 | (ert-deftest subr--tests-letrec () | ||
| 437 | ;; Test that simple cases of `letrec' get optimized back to `let*'. | ||
| 438 | (should (equal (macroexpand '(letrec ((subr-tests-var1 1) | ||
| 439 | (subr-tests-var2 subr-tests-var1)) | ||
| 440 | (+ subr-tests-var1 subr-tests-var2))) | ||
| 441 | '(let* ((subr-tests-var1 1) | ||
| 442 | (subr-tests-var2 subr-tests-var1)) | ||
| 443 | (+ subr-tests-var1 subr-tests-var2))))) | ||
| 444 | |||
| 407 | (defvar subr-tests--hook nil) | 445 | (defvar subr-tests--hook nil) |
| 408 | 446 | ||
| 409 | (ert-deftest subr-tests-add-hook-depth () | 447 | (ert-deftest subr-tests-add-hook-depth () |
diff --git a/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin new file mode 100644 index 00000000000..1905477af8c --- /dev/null +++ b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin | |||
| @@ -0,0 +1,9 @@ | |||
| 1 | First | ||
| 2 | paragraph | ||
| 3 | |||
| 4 | Second | ||
| 5 | |||
| 6 | Third | ||
| 7 | paragraph | ||
| 8 | |||
| 9 | No line end \ No newline at end of file | ||
diff --git a/test/lisp/textmodes/paragraphs-tests.el b/test/lisp/textmodes/paragraphs-tests.el index bf7f37090f5..712169029de 100644 --- a/test/lisp/textmodes/paragraphs-tests.el +++ b/test/lisp/textmodes/paragraphs-tests.el | |||
| @@ -24,6 +24,7 @@ | |||
| 24 | ;;; Code: | 24 | ;;; Code: |
| 25 | 25 | ||
| 26 | (require 'ert) | 26 | (require 'ert) |
| 27 | (require 'ert-x) | ||
| 27 | ;; (require 'paragraphs) ; loaded by default | 28 | ;; (require 'paragraphs) ; loaded by default |
| 28 | 29 | ||
| 29 | (ert-deftest paragraphs-tests-sentence-end () | 30 | (ert-deftest paragraphs-tests-sentence-end () |
| @@ -161,5 +162,27 @@ | |||
| 161 | (should (equal (buffer-string) | 162 | (should (equal (buffer-string) |
| 162 | "First sentence. Third sentence. Second sentence.")))) | 163 | "First sentence. Third sentence. Second sentence.")))) |
| 163 | 164 | ||
| 165 | (ert-deftest test-mark-paragraphs () | ||
| 166 | (with-current-buffer | ||
| 167 | (find-file-noselect (ert-resource-file "mark-paragraph.bin")) | ||
| 168 | (goto-char (point-max)) | ||
| 169 | ;; Just a sanity check that the file hasn't changed. | ||
| 170 | (should (= (point) 54)) | ||
| 171 | (mark-paragraph) | ||
| 172 | (should (= (point) 42)) | ||
| 173 | (should (= (mark) 54)) | ||
| 174 | ;; Doesn't move. | ||
| 175 | (mark-paragraph) | ||
| 176 | (should (= (point) 42)) | ||
| 177 | (should (= (mark) 54)) | ||
| 178 | (forward-line -1) | ||
| 179 | (mark-paragraph) | ||
| 180 | (should (= (point) 25)) | ||
| 181 | (should (= (mark) 42)) | ||
| 182 | (goto-char (point-min)) | ||
| 183 | (mark-paragraph) | ||
| 184 | (should (= (point) 1)) | ||
| 185 | (should (= (mark) 17)))) | ||
| 186 | |||
| 164 | (provide 'paragraphs-tests) | 187 | (provide 'paragraphs-tests) |
| 165 | ;;; paragraphs-tests.el ends here | 188 | ;;; paragraphs-tests.el ends here |
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el index 35235c65665..17fdfefce84 100644 --- a/test/lisp/wid-edit-tests.el +++ b/test/lisp/wid-edit-tests.el | |||
| @@ -301,4 +301,25 @@ return nil, even with a non-nil bubblep argument." | |||
| 301 | (should child) | 301 | (should child) |
| 302 | (should (equal (widget-value widget) '((1 "One"))))))) | 302 | (should (equal (widget-value widget) '((1 "One"))))))) |
| 303 | 303 | ||
| 304 | (ert-deftest widget-test-widget-move () | ||
| 305 | "Test moving with `widget-forward' and `widget-backward'." | ||
| 306 | (with-temp-buffer | ||
| 307 | (dolist (el '("First" "Second" "Third")) | ||
| 308 | (widget-create 'push-button el)) | ||
| 309 | (widget-insert "\n") | ||
| 310 | (use-local-map widget-keymap) | ||
| 311 | (widget-setup) | ||
| 312 | (goto-char (point-min)) | ||
| 313 | ;; Check that moving from the widget's start works. | ||
| 314 | (widget-forward 2) | ||
| 315 | (should (string= "Third" (widget-value (widget-at)))) | ||
| 316 | (widget-backward 1) | ||
| 317 | (should (string= "Second" (widget-value (widget-at)))) | ||
| 318 | ;; Check that moving from inside the widget works. | ||
| 319 | (goto-char (point-min)) | ||
| 320 | (widget-forward 2) | ||
| 321 | (forward-char) | ||
| 322 | (widget-backward 1) | ||
| 323 | (should (string= "Second" (widget-value (widget-at)))))) | ||
| 324 | |||
| 304 | ;;; wid-edit-tests.el ends here | 325 | ;;; wid-edit-tests.el ends here |
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 74fb3c892db..d4f5fc3f190 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el | |||
| @@ -248,6 +248,18 @@ g .. h foo | |||
| 248 | 0 .. 3 foo | 248 | 0 .. 3 foo |
| 249 | "))))) | 249 | "))))) |
| 250 | 250 | ||
| 251 | (ert-deftest keymap--key-description () | ||
| 252 | (should (equal (key-description [right] [?\C-x]) | ||
| 253 | "C-x <right>")) | ||
| 254 | (should (equal (key-description [M-H-right] [?\C-x]) | ||
| 255 | "C-x M-H-<right>")) | ||
| 256 | (should (equal (single-key-description 'home) | ||
| 257 | "<home>")) | ||
| 258 | (should (equal (single-key-description 'home t) | ||
| 259 | "home")) | ||
| 260 | (should (equal (single-key-description 'C-s-home) | ||
| 261 | "C-s-<home>"))) | ||
| 262 | |||
| 251 | (provide 'keymap-tests) | 263 | (provide 'keymap-tests) |
| 252 | 264 | ||
| 253 | ;;; keymap-tests.el ends here | 265 | ;;; keymap-tests.el ends here |
diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 5294bc07ce5..921bcd5f85b 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el | |||
| @@ -560,8 +560,16 @@ FD_SETSIZE file descriptors (Bug#24325)." | |||
| 560 | ;; We should have managed to start at least one process. | 560 | ;; We should have managed to start at least one process. |
| 561 | (should processes) | 561 | (should processes) |
| 562 | (dolist (process processes) | 562 | (dolist (process processes) |
| 563 | (should (process-live-p process)) | 563 | ;; The process now should either be running, or have |
| 564 | (process-send-eof process) | 564 | ;; already failed before `exec'. |
| 565 | (should (memq (process-status process) '(run exit))) | ||
| 566 | (when (process-live-p process) | ||
| 567 | (process-send-eof process)) | ||
| 568 | ;; FIXME: This `sleep-for' shouldn't be needed. It | ||
| 569 | ;; indicates a bug in Emacs; perhaps SIGCHLD is | ||
| 570 | ;; received in parallel with `accept-process-output', | ||
| 571 | ;; causing the latter to hang. | ||
| 572 | (sleep-for 0.1) | ||
| 565 | (while (accept-process-output process)) | 573 | (while (accept-process-output process)) |
| 566 | (should (eq (process-status process) 'exit)) | 574 | (should (eq (process-status process) 'exit)) |
| 567 | ;; If there's an error between fork and exec, Emacs | 575 | ;; If there's an error between fork and exec, Emacs |
| @@ -643,6 +651,8 @@ FD_SETSIZE file descriptors (Bug#24325)." | |||
| 643 | (ert-deftest process-tests/fd-setsize-no-crash/make-serial-process () | 651 | (ert-deftest process-tests/fd-setsize-no-crash/make-serial-process () |
| 644 | "Check that Emacs doesn't crash when trying to use more than | 652 | "Check that Emacs doesn't crash when trying to use more than |
| 645 | FD_SETSIZE file descriptors (Bug#24325)." | 653 | FD_SETSIZE file descriptors (Bug#24325)." |
| 654 | ;; This test cannot be run if PTYs aren't supported. | ||
| 655 | (skip-unless (not (eq system-type 'windows-nt))) | ||
| 646 | (with-timeout (60 (ert-fail "Test timed out")) | 656 | (with-timeout (60 (ert-fail "Test timed out")) |
| 647 | (process-tests--with-processes processes | 657 | (process-tests--with-processes processes |
| 648 | ;; In order to use `make-serial-process', we need to create some | 658 | ;; In order to use `make-serial-process', we need to create some |
| @@ -664,6 +674,15 @@ FD_SETSIZE file descriptors (Bug#24325)." | |||
| 664 | (tty-name (process-tty-name host))) | 674 | (tty-name (process-tty-name host))) |
| 665 | (should (processp host)) | 675 | (should (processp host)) |
| 666 | (push host processes) | 676 | (push host processes) |
| 677 | ;; FIXME: The assumption below that using :connection 'pty | ||
| 678 | ;; in make-process necessarily produces a process with PTY | ||
| 679 | ;; connection is unreliable and non-portable. | ||
| 680 | ;; make-process can legitimately and silently fall back on | ||
| 681 | ;; pipes if allocating a PTY fails (and on MS-Windows it | ||
| 682 | ;; always fails). The following code also assumes that | ||
| 683 | ;; process-tty-name produces a file name that can be | ||
| 684 | ;; passed to 'stat' and to make-serial-process, which is | ||
| 685 | ;; also non-portable. | ||
| 667 | (should tty-name) | 686 | (should tty-name) |
| 668 | (should (file-exists-p tty-name)) | 687 | (should (file-exists-p tty-name)) |
| 669 | (should-not (member tty-name tty-names)) | 688 | (should-not (member tty-name tty-names)) |