diff options
| author | Helmut Eller | 2026-04-04 20:59:46 +0200 |
|---|---|---|
| committer | Helmut Eller | 2026-04-04 20:59:46 +0200 |
| commit | 6eec001187e8551f32b6498e6dc60cdc58c2e515 (patch) | |
| tree | 13233de9f0a05ef86a51500e8b1870b75ff20c81 | |
| parent | e4ea27119e79012f9d651cb61d1115589d91ef39 (diff) | |
| parent | 01a9d78a7e4c7d7fa5b799e4fdc2caf77a012734 (diff) | |
| download | emacs-feature/igc3.tar.gz emacs-feature/igc3.zip | |
Merge branch 'master' into feature/igc3feature/igc3
109 files changed, 3737 insertions, 2614 deletions
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index bf137ef946b..77fff25b7b2 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi | |||
| @@ -868,13 +868,20 @@ otherwise stated, affects only the current Emacs session. The only | |||
| 868 | way to alter the variable in future sessions is to put something in | 868 | way to alter the variable in future sessions is to put something in |
| 869 | your initialization file (@pxref{Init File}). | 869 | your initialization file (@pxref{Init File}). |
| 870 | 870 | ||
| 871 | If you're setting a customizable variable in your initialization | ||
| 872 | file, and you don't want to use the Customize interface, you can use | ||
| 873 | the @code{setopt} macro. For instance: | ||
| 874 | |||
| 875 | @findex setopt | 871 | @findex setopt |
| 872 | If you're setting a customizable variable, and you don't want to use | ||
| 873 | the Customize interface, you can use the @code{setopt} macro. For | ||
| 874 | instance: | ||
| 875 | |||
| 876 | @example | 876 | @example |
| 877 | (setopt fill-column 75) | 877 | M-: (setopt fill-column 75) @key{RET} |
| 878 | @end example | ||
| 879 | |||
| 880 | @noindent | ||
| 881 | Or, if you want to do this in your initialization file: | ||
| 882 | |||
| 883 | @example | ||
| 884 | (setopt fill-column 75) | ||
| 878 | @end example | 885 | @end example |
| 879 | 886 | ||
| 880 | This works the same as @code{setq}, but if the variable has any | 887 | This works the same as @code{setq}, but if the variable has any |
| @@ -883,6 +890,34 @@ special setter functions, they will be run automatically when using | |||
| 883 | non-customizable variables, but this is less efficient than using | 890 | non-customizable variables, but this is less efficient than using |
| 884 | @code{setq}. | 891 | @code{setq}. |
| 885 | 892 | ||
| 893 | @findex setopt-local | ||
| 894 | There is also a buffer-local version of @code{setopt}, called | ||
| 895 | @code{setopt-local}, that you can use to set buffer specific values for | ||
| 896 | customizable options, for example, in mode hooks (@pxref{Hooks}). | ||
| 897 | |||
| 898 | This works the same as @code{setq-local}, but if the variable has any | ||
| 899 | special setter functions, they will be run automatically when using | ||
| 900 | @code{setopt-local}. You can also use @code{setopt-local} on other, | ||
| 901 | non-customizable variables, but this is less efficient than using | ||
| 902 | @code{setq-local}. | ||
| 903 | |||
| 904 | If you want to change the value of a customizable variable only in | ||
| 905 | your current buffer, you can use the @code{setopt-local} macro. For | ||
| 906 | instance: | ||
| 907 | |||
| 908 | @example | ||
| 909 | M-: (setopt-local fill-column 75) @key{RET} | ||
| 910 | @end example | ||
| 911 | |||
| 912 | @noindent | ||
| 913 | Or, if you want to do this in your initialization file, use the | ||
| 914 | following inside a mode hook so this variable will be automatically | ||
| 915 | customized in buffers of that mode (@pxref{Hooks}): | ||
| 916 | |||
| 917 | @example | ||
| 918 | (setopt-local fill-column 75) | ||
| 919 | @end example | ||
| 920 | |||
| 886 | @node Hooks | 921 | @node Hooks |
| 887 | @subsection Hooks | 922 | @subsection Hooks |
| 888 | @cindex hook | 923 | @cindex hook |
| @@ -3262,7 +3297,7 @@ acquainted with conventions from other programs. | |||
| 3262 | The functionality enabled by the @code{newcomers-presets} theme will | 3297 | The functionality enabled by the @code{newcomers-presets} theme will |
| 3263 | change between releases of Emacs. We may add new functionality, and | 3298 | change between releases of Emacs. We may add new functionality, and |
| 3264 | also remove old functionality that we think has been superseded. | 3299 | also remove old functionality that we think has been superseded. |
| 3265 | Therefore, if you get used to the newcomers' presets, consider copying | 3300 | Therefore, if you get used to the newcomers' presets, you should copy |
| 3266 | them into your own configuration and then disabling the theme again. | 3301 | them into your own configuration and then disable the theme again. You |
| 3267 | You can use the command @code{copy-theme-options} (@pxref{Custom | 3302 | can use the command @code{copy-theme-options} (@pxref{Custom Themes}) to |
| 3268 | Themes}) to do this. | 3303 | do this. |
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 4aee5e1045d..697a13dbe7b 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi | |||
| @@ -2764,10 +2764,10 @@ Table}.) | |||
| 2764 | @node Xref Commands | 2764 | @node Xref Commands |
| 2765 | @subsubsection Commands Available in the @file{*xref*} Buffer | 2765 | @subsubsection Commands Available in the @file{*xref*} Buffer |
| 2766 | @cindex commands in @file{*xref*} buffers | 2766 | @cindex commands in @file{*xref*} buffers |
| 2767 | @cindex XREF mode | 2767 | @cindex Xref mode |
| 2768 | 2768 | ||
| 2769 | The following commands are provided in the @file{*xref*} buffer by | 2769 | The following commands are provided in the @file{*xref*} buffer by |
| 2770 | the special XREF mode: | 2770 | the special Xref mode: |
| 2771 | 2771 | ||
| 2772 | @table @kbd | 2772 | @table @kbd |
| 2773 | @item @key{RET} | 2773 | @item @key{RET} |
| @@ -2880,7 +2880,7 @@ prompt always, customize the value of the variable | |||
| 2880 | to prompt only if there's no usable identifier at point.) The command | 2880 | to prompt only if there's no usable identifier at point.) The command |
| 2881 | then presents the @file{*xref*} buffer with all the references to the | 2881 | then presents the @file{*xref*} buffer with all the references to the |
| 2882 | identifier, showing the file name and the line where the identifier is | 2882 | identifier, showing the file name and the line where the identifier is |
| 2883 | referenced. The XREF mode commands are available in this buffer, see | 2883 | referenced. The Xref mode commands are available in this buffer, see |
| 2884 | @ref{Xref Commands}. | 2884 | @ref{Xref Commands}. |
| 2885 | 2885 | ||
| 2886 | When invoked in a buffer whose major mode uses the @code{etags} backend, | 2886 | When invoked in a buffer whose major mode uses the @code{etags} backend, |
| @@ -2926,6 +2926,16 @@ matches of that regexp in the names of the identifiers with | |||
| 2926 | @code{xref-query-replace-in-results}, but is more convenient when you | 2926 | @code{xref-query-replace-in-results}, but is more convenient when you |
| 2927 | want to rename a single identifier specified by its name @var{from}. | 2927 | want to rename a single identifier specified by its name @var{from}. |
| 2928 | 2928 | ||
| 2929 | @findex xref-change-to-xref-edit-mode | ||
| 2930 | @cindex Xref Edit mode | ||
| 2931 | @cindex mode, Xref Edit | ||
| 2932 | Typing @kbd{e} in the @file{*xref*} buffer makes the buffer writable | ||
| 2933 | and enters the Xref Edit mode. Similar to Occur Edit mode (@pxref{Other | ||
| 2934 | Repeating Search}), you can edit the matching lines reported by | ||
| 2935 | Xref backend and have those changes reflected in the buffer visiting the | ||
| 2936 | originating file. Type @kbd{C-c C-c} to leave the Xref Edit mode and | ||
| 2937 | return to the Xref mode. | ||
| 2938 | |||
| 2929 | @findex tags-search | 2939 | @findex tags-search |
| 2930 | @kbd{M-x tags-search} reads a regexp using the minibuffer, then | 2940 | @kbd{M-x tags-search} reads a regexp using the minibuffer, then |
| 2931 | searches for matches in all the files in the selected tags table, one | 2941 | searches for matches in all the files in the selected tags table, one |
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 1497a9906bd..a712b3a1b46 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi | |||
| @@ -14660,9 +14660,9 @@ beginning of the file. The function definition looks like this: | |||
| 14660 | @smallexample | 14660 | @smallexample |
| 14661 | @group | 14661 | @group |
| 14662 | (defun lengths-list-file (filename) | 14662 | (defun lengths-list-file (filename) |
| 14663 | "Return list of definitions' lengths within FILE. | 14663 | "Return list of definitions' lengths within the file named FILENAME. |
| 14664 | The returned list is a list of numbers. | 14664 | The returned list is a list of numbers. |
| 14665 | Each number is the number of words or | 14665 | Each number in the list is the number of words or |
| 14666 | symbols in one function definition." | 14666 | symbols in one function definition." |
| 14667 | @end group | 14667 | @end group |
| 14668 | @group | 14668 | @group |
| @@ -14683,10 +14683,10 @@ symbols in one function definition." | |||
| 14683 | @end smallexample | 14683 | @end smallexample |
| 14684 | 14684 | ||
| 14685 | @noindent | 14685 | @noindent |
| 14686 | The function is passed one argument, the name of the file on which it | 14686 | The function is passed one argument @var{filename}, the name of the file |
| 14687 | will work. It has four lines of documentation, but no interactive | 14687 | on which it will work. It has four lines of documentation, but no |
| 14688 | specification. Since people worry that a computer is broken if they | 14688 | interactive specification. Since people worry that a computer is broken |
| 14689 | don't see anything going on, the first line of the body is a | 14689 | if they don't see anything going on, the first line of the body is a |
| 14690 | message. | 14690 | message. |
| 14691 | 14691 | ||
| 14692 | The next line contains a @code{save-excursion} that returns Emacs's | 14692 | The next line contains a @code{save-excursion} that returns Emacs's |
| @@ -14730,8 +14730,8 @@ definition and constructs a lengths' list containing the information. | |||
| 14730 | Emacs kills the buffer after working through it. This is to save | 14730 | Emacs kills the buffer after working through it. This is to save |
| 14731 | space inside of Emacs. My version of GNU Emacs 19 contained over 300 | 14731 | space inside of Emacs. My version of GNU Emacs 19 contained over 300 |
| 14732 | source files of interest; GNU Emacs 22 contains over a thousand source | 14732 | source files of interest; GNU Emacs 22 contains over a thousand source |
| 14733 | files. Another function will apply @code{lengths-list-file} to each | 14733 | files, and Emacs 30.2 more than 1600. Another function will apply |
| 14734 | of the files. | 14734 | @code{lengths-list-file} to each of the files. |
| 14735 | 14735 | ||
| 14736 | Finally, the last expression within the @code{let} expression is the | 14736 | Finally, the last expression within the @code{let} expression is the |
| 14737 | @code{lengths-list} variable; its value is returned as the value of | 14737 | @code{lengths-list} variable; its value is returned as the value of |
| @@ -14744,13 +14744,13 @@ C-e} (@code{eval-last-sexp}). | |||
| 14744 | @c !!! 22.1.1 lisp sources location here | 14744 | @c !!! 22.1.1 lisp sources location here |
| 14745 | @smallexample | 14745 | @smallexample |
| 14746 | (lengths-list-file | 14746 | (lengths-list-file |
| 14747 | "/usr/local/share/emacs/22.1/lisp/emacs-lisp/debug.el") | 14747 | "/usr/local/share/emacs/30.2/lisp/emacs-lisp/debug.el") |
| 14748 | @end smallexample | 14748 | @end smallexample |
| 14749 | 14749 | ||
| 14750 | @noindent | 14750 | @noindent |
| 14751 | You may need to change the pathname of the file; the one here is for | 14751 | You may need to change the name of the file; the one here is for default |
| 14752 | GNU Emacs version 22.1. To change the expression, copy it to | 14752 | installation tree of GNU Emacs version 30.2. To change the expression, |
| 14753 | the @file{*scratch*} buffer and edit it. | 14753 | copy it to the @file{*scratch*} buffer and edit it. |
| 14754 | 14754 | ||
| 14755 | @need 1200 | 14755 | @need 1200 |
| 14756 | @noindent | 14756 | @noindent |
| @@ -14768,10 +14768,11 @@ Then evaluate the @code{lengths-list-file} expression.) | |||
| 14768 | 14768 | ||
| 14769 | @need 1200 | 14769 | @need 1200 |
| 14770 | The lengths' list for @file{debug.el} takes less than a second to | 14770 | The lengths' list for @file{debug.el} takes less than a second to |
| 14771 | produce and looks like this in GNU Emacs 22: | 14771 | produce and looks like this in GNU Emacs 30.2: |
| 14772 | 14772 | ||
| 14773 | @smallexample | 14773 | @smallexample |
| 14774 | (83 113 105 144 289 22 30 97 48 89 25 52 52 88 28 29 77 49 43 290 232 587) | 14774 | (79 26 140 34 17 112 81 24 155 54 43 102 21 36 36 117 28 29 102 49 43 |
| 14775 | 208 101 28 22 728 15 27) | ||
| 14775 | @end smallexample | 14776 | @end smallexample |
| 14776 | 14777 | ||
| 14777 | @need 1500 | 14778 | @need 1500 |
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 364edf63031..705af15e4e2 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi | |||
| @@ -372,12 +372,15 @@ added by calls to @code{custom-add-frequent-value} (see below). | |||
| 372 | @item :set @var{setfunction} | 372 | @item :set @var{setfunction} |
| 373 | Specify @var{setfunction} as the way to change the value of this | 373 | Specify @var{setfunction} as the way to change the value of this |
| 374 | option when using the Customize interface. The function | 374 | option when using the Customize interface. The function |
| 375 | @var{setfunction} should take two arguments, a symbol (the option | 375 | @var{setfunction} should take two or three arguments, a symbol (the option |
| 376 | name) and the new value, and should do whatever is necessary to update | 376 | name), the new value, and an optional @var{buffer-local} indicator. |
| 377 | @var{setfunction} should do whatever is necessary to update | ||
| 377 | the value properly for this option (which may not mean simply setting | 378 | the value properly for this option (which may not mean simply setting |
| 378 | the option as a Lisp variable); preferably, though, it should not | 379 | the option as a Lisp variable); preferably, though, it should not |
| 379 | modify its value argument destructively. The default for | 380 | modify its value argument destructively. If optional @var{buffer-local} |
| 380 | @var{setfunction} is @code{set-default-toplevel-value}. | 381 | is non-nil, the new value should be set buffer locally and not affect its |
| 382 | global or default values. The default for @var{setfunction} is | ||
| 383 | @code{set-default-toplevel-value}. | ||
| 381 | 384 | ||
| 382 | If defined, @var{setfunction} will also be called when evaluating a | 385 | If defined, @var{setfunction} will also be called when evaluating a |
| 383 | @code{defcustom} form with @kbd{C-M-x} in Emacs Lisp mode and when the | 386 | @code{defcustom} form with @kbd{C-M-x} in Emacs Lisp mode and when the |
| @@ -387,7 +390,7 @@ If defined, @var{setfunction} will also be called when evaluating a | |||
| 387 | If you specify this keyword, the variable's documentation string | 390 | If you specify this keyword, the variable's documentation string |
| 388 | should describe how to do the same job in hand-written Lisp code, | 391 | should describe how to do the same job in hand-written Lisp code, |
| 389 | either by invoking @var{setfunction} directly or by using | 392 | either by invoking @var{setfunction} directly or by using |
| 390 | @code{setopt}. | 393 | @code{setopt} or @code{setopt-local}. |
| 391 | 394 | ||
| 392 | @kindex get@r{, @code{defcustom} keyword} | 395 | @kindex get@r{, @code{defcustom} keyword} |
| 393 | @item :get @var{getfunction} | 396 | @item :get @var{getfunction} |
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 656a422cf6e..9115b3a4691 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi | |||
| @@ -1661,6 +1661,7 @@ Tips and Conventions | |||
| 1661 | * Compilation Tips:: Making compiled code run fast. | 1661 | * Compilation Tips:: Making compiled code run fast. |
| 1662 | * Warning Tips:: Turning off compiler warnings. | 1662 | * Warning Tips:: Turning off compiler warnings. |
| 1663 | * Documentation Tips:: Writing readable documentation strings. | 1663 | * Documentation Tips:: Writing readable documentation strings. |
| 1664 | * Documentation Group Tips:: Writing useful documentation groups. | ||
| 1664 | * Comment Tips:: Conventions for writing comments. | 1665 | * Comment Tips:: Conventions for writing comments. |
| 1665 | * Library Headers:: Standard headers for library packages. | 1666 | * Library Headers:: Standard headers for library packages. |
| 1666 | 1667 | ||
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 049e8ac3e84..f86a18fd896 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi | |||
| @@ -2777,6 +2777,9 @@ the end of the file name. | |||
| 2777 | 2777 | ||
| 2778 | If @var{text} is a string, @code{make-temp-file} inserts it in the file. | 2778 | If @var{text} is a string, @code{make-temp-file} inserts it in the file. |
| 2779 | 2779 | ||
| 2780 | On Posix systems, Emacs creates the file with permissions that limit its | ||
| 2781 | access to the current user. | ||
| 2782 | |||
| 2780 | To prevent conflicts among different libraries running in the same | 2783 | To prevent conflicts among different libraries running in the same |
| 2781 | Emacs, each Lisp program that uses @code{make-temp-file} should have its | 2784 | Emacs, each Lisp program that uses @code{make-temp-file} should have its |
| 2782 | own @var{prefix}. The number added to the end of @var{prefix} | 2785 | own @var{prefix}. The number added to the end of @var{prefix} |
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index d57d643e922..c50619a2de0 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi | |||
| @@ -89,6 +89,20 @@ displayed on that terminal; the list of possible values is the same as | |||
| 89 | for @code{framep} above. | 89 | for @code{framep} above. |
| 90 | @end defun | 90 | @end defun |
| 91 | 91 | ||
| 92 | @defun frame-initial-p &optional frame | ||
| 93 | This predicate returns non-@code{nil} if @var{frame} is or holds the | ||
| 94 | initial text frame that is used internally during daemon mode | ||
| 95 | (@pxref{Initial Options, daemon,, emacs, The GNU Emacs Manual}), batch | ||
| 96 | mode (@pxref{Batch Mode}), and the early stages of startup | ||
| 97 | (@pxref{Startup Summary}). Interactive and graphical programs, for | ||
| 98 | instance, can use this predicate to avoid operating on the initial | ||
| 99 | frame, which is never displayed. | ||
| 100 | |||
| 101 | If @var{frame} is a terminal, this function returns non-@code{nil} if | ||
| 102 | @var{frame} holds the initial frame. If @var{frame} is omitted or | ||
| 103 | @code{nil}, it defaults to the selected one. | ||
| 104 | @end defun | ||
| 105 | |||
| 92 | @cindex top-level frame | 106 | @cindex top-level frame |
| 93 | On a graphical terminal we distinguish two types of frames: A normal | 107 | On a graphical terminal we distinguish two types of frames: A normal |
| 94 | @dfn{top-level frame} is a frame whose window-system window is a child | 108 | @dfn{top-level frame} is a frame whose window-system window is a child |
| @@ -3029,7 +3043,7 @@ direction. | |||
| 3029 | See also @code{next-window} and @code{previous-window}, in @ref{Cyclic | 3043 | See also @code{next-window} and @code{previous-window}, in @ref{Cyclic |
| 3030 | Window Ordering}. | 3044 | Window Ordering}. |
| 3031 | 3045 | ||
| 3032 | Some Lisp programs need to find one or more frames that satisfy a | 3046 | Some Lisp programs need to find one or more frames that satisfy |
| 3033 | given criteria. The function @code{filtered-frame-list} is provided for | 3047 | given criteria. The function @code{filtered-frame-list} is provided for |
| 3034 | this purpose. | 3048 | this purpose. |
| 3035 | 3049 | ||
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 3261cf838f7..a9bc9221912 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi | |||
| @@ -828,14 +828,16 @@ if the user types the help character again. | |||
| 828 | @cindex documentation groups | 828 | @cindex documentation groups |
| 829 | @cindex groups of functions | 829 | @cindex groups of functions |
| 830 | @cindex function groups | 830 | @cindex function groups |
| 831 | @cindex shortdoc groups | ||
| 831 | 832 | ||
| 832 | Emacs can list functions based on various groupings. For instance, | 833 | Emacs can list functions based on various groupings. For instance, |
| 833 | @code{string-trim} and @code{mapconcat} are ``string'' functions, so | 834 | @code{string-trim} and @code{mapconcat} are ``string'' functions, so |
| 834 | @kbd{M-x shortdoc RET string RET} will give an overview | 835 | @kbd{M-x shortdoc RET string RET} will give an overview of these and |
| 835 | of functions that operate on strings. | 836 | other functions that operate on strings. |
| 836 | 837 | ||
| 837 | The documentation groups are created with the | 838 | The documentation groups are created with the |
| 838 | @code{define-short-documentation-group} macro. | 839 | @code{define-short-documentation-group} macro. @xref{Documentation |
| 840 | Group Tips}, for how to write good documentation groups. | ||
| 839 | 841 | ||
| 840 | @defmac define-short-documentation-group group &rest functions | 842 | @defmac define-short-documentation-group group &rest functions |
| 841 | Define @var{group} as a group of functions, and provide short | 843 | Define @var{group} as a group of functions, and provide short |
| @@ -846,6 +848,7 @@ summaries of using those functions. The optional argument | |||
| 846 | (@var{func} [@var{keyword} @var{val}]@dots{}) | 848 | (@var{func} [@var{keyword} @var{val}]@dots{}) |
| 847 | @end lisp | 849 | @end lisp |
| 848 | 850 | ||
| 851 | @cindex documentation group keywords | ||
| 849 | The following keywords are recognized: | 852 | The following keywords are recognized: |
| 850 | 853 | ||
| 851 | @table @code | 854 | @table @code |
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 7f22dc06ef2..2fbac9508d6 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi | |||
| @@ -35,6 +35,7 @@ in batch mode, e.g., with a command run by @kbd{@w{M-x compile | |||
| 35 | * Compilation Tips:: Making compiled code run fast. | 35 | * Compilation Tips:: Making compiled code run fast. |
| 36 | * Warning Tips:: Turning off compiler warnings. | 36 | * Warning Tips:: Turning off compiler warnings. |
| 37 | * Documentation Tips:: Writing readable documentation strings. | 37 | * Documentation Tips:: Writing readable documentation strings. |
| 38 | * Documentation Group Tips:: Writing useful documentation groups. | ||
| 38 | * Comment Tips:: Conventions for writing comments. | 39 | * Comment Tips:: Conventions for writing comments. |
| 39 | * Library Headers:: Standard headers for library packages. | 40 | * Library Headers:: Standard headers for library packages. |
| 40 | @end menu | 41 | @end menu |
| @@ -934,6 +935,89 @@ If you do not anticipate anyone editing your code with older Emacs | |||
| 934 | versions, there is no need for this work-around. | 935 | versions, there is no need for this work-around. |
| 935 | @end itemize | 936 | @end itemize |
| 936 | 937 | ||
| 938 | @node Documentation Group Tips | ||
| 939 | @section Tips for Documentation Groups | ||
| 940 | @cindex documentation groups, tips | ||
| 941 | @cindex tips for documentation groups | ||
| 942 | |||
| 943 | @cindex documentation groups, compatibility | ||
| 944 | Documentation groups, available since Emacs 28, are useful to document | ||
| 945 | functions of Lisp packages based on various groupings | ||
| 946 | (@pxref{Documentation Groups}). This section gives some tips on how you | ||
| 947 | can define documentation groups in your Lisp package in a way such that | ||
| 948 | users of different Emacs versions can equally well use these groups. | ||
| 949 | |||
| 950 | @itemize @bullet | ||
| 951 | @item | ||
| 952 | To define documentation groups for your own Lisp package across | ||
| 953 | different Emacs versions, you can use a boilerplate template along the | ||
| 954 | lines of the following to make your package compile and load without | ||
| 955 | errors: | ||
| 956 | |||
| 957 | @smallexample | ||
| 958 | @group | ||
| 959 | ;;; well-doc.el --- a well-documented package -*- lexical-binding: t; -*- | ||
| 960 | |||
| 961 | @dots{} package header and contents @dots{} | ||
| 962 | @end group | ||
| 963 | |||
| 964 | @group | ||
| 965 | ;; Explicitly require shortdoc for Emacs 28, which does not have an | ||
| 966 | ;; autoload for macro `define-short-documentation-group'. And for | ||
| 967 | ;; Emacs 30, so that we can redefine `shortdoc--check' later. | ||
| 968 | (require 'shortdoc nil t) | ||
| 969 | |||
| 970 | (eval-when-compile | ||
| 971 | |||
| 972 | ;; Default macro `define-short-documentation-group' for Emacs 27 | ||
| 973 | ;; and older, which do not have the shortdoc feature at all. | ||
| 974 | (unless (fboundp 'define-short-documentation-group) | ||
| 975 | (defmacro define-short-documentation-group (&rest _))) | ||
| 976 | |||
| 977 | ;; Disable too rigid shortdoc checks for Emacs 30, which let it | ||
| 978 | ;; error out on newer shortdoc keywords. | ||
| 979 | (when (eq emacs-major-version 30) | ||
| 980 | (fset 'shortdoc--check #'ignore))) | ||
| 981 | @end group | ||
| 982 | |||
| 983 | @group | ||
| 984 | (define-short-documentation-group well-doc | ||
| 985 | @dots{}) | ||
| 986 | |||
| 987 | ;;; well-doc.el ends here | ||
| 988 | @end group | ||
| 989 | @end smallexample | ||
| 990 | |||
| 991 | @findex define-short-documentation-group | ||
| 992 | If you do not intend to support some of the Emacs versions mentioned | ||
| 993 | above, you can safely omit the corresponding forms from the template. | ||
| 994 | If you intend to support only Emacs 31 and newer, you do not need any | ||
| 995 | of the above and can just use @code{define-short-documentation-group}. | ||
| 996 | |||
| 997 | @item | ||
| 998 | @cindex documentation group keywords, compatibility | ||
| 999 | Newer Emacs versions might introduce newer documentation group features | ||
| 1000 | and keywords. However, these features or keywords will never break the | ||
| 1001 | display of a documentation group in older Emacs versions. Suppose you | ||
| 1002 | use a hypothetical group keyword @code{:super-pretty-print}, available | ||
| 1003 | in some future Emacs version, like this in your Lisp package | ||
| 1004 | @file{well-doc.el}: | ||
| 1005 | |||
| 1006 | @smallexample | ||
| 1007 | @group | ||
| 1008 | (define-short-documentation-group well-doc | ||
| 1009 | (well-doc-foo | ||
| 1010 | :eval (well-doc-foo) | ||
| 1011 | :super-pretty-print t)) | ||
| 1012 | @end group | ||
| 1013 | @end smallexample | ||
| 1014 | |||
| 1015 | That future Emacs version will then supposedly super-pretty-print the | ||
| 1016 | example for function @code{well-doc-foo}. Older Emacs versions will | ||
| 1017 | silently ignore keyword @code{:super-pretty-print} and show the example | ||
| 1018 | according to their regular display rules. | ||
| 1019 | @end itemize | ||
| 1020 | |||
| 937 | @node Comment Tips | 1021 | @node Comment Tips |
| 938 | @section Tips on Writing Comments | 1022 | @section Tips on Writing Comments |
| 939 | @cindex comments, Lisp convention for | 1023 | @cindex comments, Lisp convention for |
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index b75a037f78b..23b6dce2ec6 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi | |||
| @@ -6728,6 +6728,45 @@ See the docstring of variable @code{tramp-methods} for possible | |||
| 6728 | @code{foo-tramp-executable} in this example would be a Lisp constant, | 6728 | @code{foo-tramp-executable} in this example would be a Lisp constant, |
| 6729 | which is the program name of @command{foo}. | 6729 | which is the program name of @command{foo}. |
| 6730 | 6730 | ||
| 6731 | If a parameter doesn't have a static value but must be computed at | ||
| 6732 | runtime, a format specifier can be used, like @t{"%h"} in the example | ||
| 6733 | above. See the docstring of @code{tramp-methods}, which patterns are | ||
| 6734 | expanded in which parameter. Furthermore, other format specifiers can | ||
| 6735 | be added via the variable @code{tramp-extra-expand-args}. | ||
| 6736 | |||
| 6737 | The following parameters expand format specifiers for the | ||
| 6738 | @code{tramp-sh} backend: @code{tramp-copy-args}, | ||
| 6739 | @code{tramp-copy-env}, @code{tramp-copy-file-name}, | ||
| 6740 | @code{tramp-login-args}, @code{tramp-login-program}, | ||
| 6741 | @code{tramp-remote-copy-args}. | ||
| 6742 | |||
| 6743 | The example above could use | ||
| 6744 | |||
| 6745 | @lisp | ||
| 6746 | (tramp-login-program "%1") | ||
| 6747 | @end lisp | ||
| 6748 | |||
| 6749 | And you could set @code{tramp-extra-expand-args} as connection-local value: | ||
| 6750 | |||
| 6751 | @lisp | ||
| 6752 | @group | ||
| 6753 | (defun foo-tramp-get-login-program (vec) | ||
| 6754 | "Return connection-local value of `tramp-login-program'." | ||
| 6755 | @dots{}) | ||
| 6756 | @end group | ||
| 6757 | |||
| 6758 | @group | ||
| 6759 | (connection-local-set-profile-variables | ||
| 6760 | 'foo-tramp-connection-local-default-profile | ||
| 6761 | '((tramp-extra-expand-args | ||
| 6762 | ?1 (foo-tramp-get-login-program (car tramp-current-connection))))) | ||
| 6763 | |||
| 6764 | (connection-local-set-profiles | ||
| 6765 | '(:application tramp :protocol "foo") | ||
| 6766 | foo-tramp-connection-local-default-profile) | ||
| 6767 | @end group | ||
| 6768 | @end lisp | ||
| 6769 | |||
| 6731 | Another initialization could tell @value{tramp} which are the default | 6770 | Another initialization could tell @value{tramp} which are the default |
| 6732 | user and host name for method @option{foo}. This is done by calling | 6771 | user and host name for method @option{foo}. This is done by calling |
| 6733 | @code{tramp-set-completion-function}: | 6772 | @code{tramp-set-completion-function}: |
diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 20c2208c54c..81becb41eba 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS | |||
| @@ -18,7 +18,16 @@ to look up issue github#1234, go to | |||
| 18 | https://github.com/joaotavora/eglot/issues/1234. | 18 | https://github.com/joaotavora/eglot/issues/1234. |
| 19 | 19 | ||
| 20 | 20 | ||
| 21 | * Changes to upcoming Eglot | 21 | * Changes in Eglot 1.23 (2/4/2026) |
| 22 | |||
| 23 | ** Unbreak ELPA Eglot (github#1584) | ||
| 24 | |||
| 25 | Broken due to bad 'jsonrpc.el' dependency. | ||
| 26 | |||
| 27 | ** 'eglot-report-progress' can be safely set to 'messages' (bug#80653) | ||
| 28 | |||
| 29 | |||
| 30 | * Changes in Eglot 1.22 (1/4/2026) | ||
| 22 | 31 | ||
| 23 | ** File watch limits to prevent resource exhaustion (github#1568) | 32 | ** File watch limits to prevent resource exhaustion (github#1568) |
| 24 | 33 | ||
| @@ -50,6 +59,19 @@ beneficial and helps servers avoid costly useless work. | |||
| 50 | Eglot now sets 'imenu-create-index-function' using ':override' advice, | 59 | Eglot now sets 'imenu-create-index-function' using ':override' advice, |
| 51 | making the integration cleaner and more predictable. | 60 | making the integration cleaner and more predictable. |
| 52 | 61 | ||
| 62 | ** Diagnostics from unopened files recalled on session start (github#1531) | ||
| 63 | |||
| 64 | Some servers (notably rust-analyzer) publish diagnostics for all | ||
| 65 | project files at startup and never republish them on 'didOpen'. Eglot | ||
| 66 | now saves such early diagnostics and reports them when those files are | ||
| 67 | subsequently opened. | ||
| 68 | |||
| 69 | ** Changes to 'eglot-server-programs' | ||
| 70 | |||
| 71 | - new 'static-ls' for 'haskell-mode' | ||
| 72 | - new 'wat_server' for 'wat-mode' (WebAssembly Text) (bug#80188) | ||
| 73 | - new 'elp' replaces 'erlang_ls' for 'erlang-mode' (bug#79943) | ||
| 74 | |||
| 53 | ** Fixed textDocument/prepareRename support (github#1554) | 75 | ** Fixed textDocument/prepareRename support (github#1554) |
| 54 | 76 | ||
| 55 | Eglot now properly checks server capabilities before sending | 77 | Eglot now properly checks server capabilities before sending |
| @@ -1760,6 +1760,15 @@ If 'page-delimiters' is set in 'whitespace-style', or the new minor mode | |||
| 1760 | width of the window. The new 'whitespace-page-delimiter' face can be | 1760 | width of the window. The new 'whitespace-page-delimiter' face can be |
| 1761 | used to customize the appearance. | 1761 | used to customize the appearance. |
| 1762 | 1762 | ||
| 1763 | --- | ||
| 1764 | *** New user option 'whitespace-global-mode-buffers'. | ||
| 1765 | Normally, 'global-whitespace-mode' skips special buffers whose name | ||
| 1766 | starts with an asterisk '*'. This user option provides an override: it | ||
| 1767 | contains a list of regular expressions used to match the names of | ||
| 1768 | special buffers in which 'global-whitespace-mode' should turn on. The | ||
| 1769 | default value preserves the existing exception for the "*scratch*" | ||
| 1770 | buffer. | ||
| 1771 | |||
| 1763 | ** Bookmark | 1772 | ** Bookmark |
| 1764 | 1773 | ||
| 1765 | --- | 1774 | --- |
| @@ -2531,6 +2540,12 @@ of a literal newline. This prevents executing many Dired operations on | |||
| 2531 | such a file from failing and signaling an error. The default value of | 2540 | such a file from failing and signaling an error. The default value of |
| 2532 | this user option is nil. | 2541 | this user option is nil. |
| 2533 | 2542 | ||
| 2543 | --- | ||
| 2544 | *** New Dired handling of errors from 'ls'. | ||
| 2545 | When invoking a Dired command causes 'ls' to emit an error message, | ||
| 2546 | Emacs now displays the message in a popped up buffer instead of | ||
| 2547 | outputting it in the Dired buffer and signaling an error. | ||
| 2548 | |||
| 2534 | ** Grep | 2549 | ** Grep |
| 2535 | 2550 | ||
| 2536 | +++ | 2551 | +++ |
| @@ -3187,6 +3202,11 @@ This minor mode binds 'xref-find-definitions-at-mouse' to | |||
| 3187 | definition, following the convention from other editors. The global | 3202 | definition, following the convention from other editors. The global |
| 3188 | minor mode 'global-xref-mouse-mode' will enable this in all buffers. | 3203 | minor mode 'global-xref-mouse-mode' will enable this in all buffers. |
| 3189 | 3204 | ||
| 3205 | +++ | ||
| 3206 | *** New command 'xref-change-to-xref-edit-mode'. | ||
| 3207 | It's bound to "e" and it switches an Xref buffer into an "editable" mode | ||
| 3208 | like similar features in Occur and Grep buffers. | ||
| 3209 | |||
| 3190 | ** Revert | 3210 | ** Revert |
| 3191 | 3211 | ||
| 3192 | +++ | 3212 | +++ |
| @@ -4093,6 +4113,14 @@ unlike 'char-displayable-p', does not check whether the character can be | |||
| 4093 | encoded by the underlying terminal. | 4113 | encoded by the underlying terminal. |
| 4094 | 4114 | ||
| 4095 | +++ | 4115 | +++ |
| 4116 | ** New function 'frame-initial-p'. | ||
| 4117 | This predicate returns non-nil if a given frame or terminal is or holds, | ||
| 4118 | respectively, the initial text frame that is used internally during | ||
| 4119 | daemon mode, batch mode, and the early stages of startup. Interactive | ||
| 4120 | and graphical programs, for instance, can use this predicate to avoid | ||
| 4121 | operating on the initial frame, which is never displayed. | ||
| 4122 | |||
| 4123 | +++ | ||
| 4096 | ** New macros 'static-when' and 'static-unless'. | 4124 | ** New macros 'static-when' and 'static-unless'. |
| 4097 | Like 'static-if', these macros evaluate their condition at | 4125 | Like 'static-if', these macros evaluate their condition at |
| 4098 | macro-expansion time and are useful for writing code that can work | 4126 | macro-expansion time and are useful for writing code that can work |
| @@ -4124,6 +4152,17 @@ change it globally with: | |||
| 4124 | --- | 4152 | --- |
| 4125 | *** Loading a file displays a warning if there is no 'lexical-binding' cookie. | 4153 | *** Loading a file displays a warning if there is no 'lexical-binding' cookie. |
| 4126 | 4154 | ||
| 4155 | --- | ||
| 4156 | ** New function 'set-local'. | ||
| 4157 | This is the buffer local equivalent of the function 'set'. | ||
| 4158 | |||
| 4159 | +++ | ||
| 4160 | ** New macro 'setopt-local'. | ||
| 4161 | This is the buffer local version of 'setopt' for user options rather | ||
| 4162 | than plain variables and uses 'custom-set'/'set-local' to set variable | ||
| 4163 | values. A new argument, BUFFER-LOCAL, is passed to 'custom-set' | ||
| 4164 | functions to indicate the buffer local context. | ||
| 4165 | |||
| 4127 | +++ | 4166 | +++ |
| 4128 | ** New macros 'incf' and 'decf'. | 4167 | ** New macros 'incf' and 'decf'. |
| 4129 | They increment or decrement the value stored in a variable (a symbol), | 4168 | They increment or decrement the value stored in a variable (a symbol), |
| @@ -4459,6 +4498,13 @@ singleton list. | |||
| 4459 | * Changes in Emacs 31.1 on Non-Free Operating Systems | 4498 | * Changes in Emacs 31.1 on Non-Free Operating Systems |
| 4460 | 4499 | ||
| 4461 | --- | 4500 | --- |
| 4501 | ** Support macOS Accessibility Zoom focus tracking. | ||
| 4502 | This is an important change for visually-impaired users. If macOS | ||
| 4503 | Accessibility Zoom is enabled (System Settings, Accessibility, Zoom) | ||
| 4504 | with keyboard focus tracking (Advanced...), Zoom is informed of updated | ||
| 4505 | cursor positions during each redisplay cycle. | ||
| 4506 | |||
| 4507 | --- | ||
| 4462 | ** Process execution has been optimized on Android. | 4508 | ** Process execution has been optimized on Android. |
| 4463 | The run-time performance of subprocesses on recent Android releases, | 4509 | The run-time performance of subprocesses on recent Android releases, |
| 4464 | where a userspace executable loader is required, has been optimized on | 4510 | where a userspace executable loader is required, has been optimized on |
diff --git a/etc/themes/newcomers-presets-theme.el b/etc/themes/newcomers-presets-theme.el index b14465d8e3f..12205a4ee8e 100644 --- a/etc/themes/newcomers-presets-theme.el +++ b/etc/themes/newcomers-presets-theme.el | |||
| @@ -21,11 +21,20 @@ | |||
| 21 | 21 | ||
| 22 | ;;; Commentary | 22 | ;;; Commentary |
| 23 | 23 | ||
| 24 | ;; A theme that enables user options new users might be interested in. | 24 | ;; This theme configures user options that we can reasonably expect the |
| 25 | ;; The guideline to enabling a feature is "would this interest someone | 25 | ;; average, new user to want to enable, but would otherwise be unlikely |
| 26 | ;; who wouldn't even know that this option exists?". Please avoid | 26 | ;; to discover on their own. This includes support for convenience |
| 27 | ;; opinionated cosmetic changes, that is the job of regular/color-scheme | 27 | ;; features, adjustment of default settings that are in place for |
| 28 | ;; themes. | 28 | ;; historical reasons, aiding discoverability (at the potential cost of |
| 29 | ;; more visual noise) and trying and follow common conventions that | ||
| 30 | ;; other editors have established over the past decades. | ||
| 31 | |||
| 32 | ;; The goal is to help providing a better starting point for users who | ||
| 33 | ;; would otherwise feel overwhelmed when first starting to use Emacs, | ||
| 34 | ;; without having to burden existing users with invasive changes to | ||
| 35 | ;; Emacs' default behavior. Options in the theme should NOT hinder | ||
| 36 | ;; developing a better understanding of Emacs (e.g. enabling emulation | ||
| 37 | ;; modes) or make opinionated cosmetic changes. | ||
| 29 | 38 | ||
| 30 | ;;; Code: | 39 | ;;; Code: |
| 31 | 40 | ||
| @@ -120,6 +129,7 @@ This minor mode will enable and disable the theme on startup." | |||
| 120 | '(indent-tabs-mode nil) | 129 | '(indent-tabs-mode nil) |
| 121 | '(imenu-auto-rescan t) | 130 | '(imenu-auto-rescan t) |
| 122 | '(view-read-only t) | 131 | '(view-read-only t) |
| 132 | '(column-number-mode t) | ||
| 123 | 133 | ||
| 124 | ;;;; Directory managment-related options | 134 | ;;;; Directory managment-related options |
| 125 | '(dired-auto-revert-buffer t) | 135 | '(dired-auto-revert-buffer t) |
| @@ -153,7 +163,10 @@ This minor mode will enable and disable the theme on startup." | |||
| 153 | ;;;; Frame- and window-related options | 163 | ;;;; Frame- and window-related options |
| 154 | '(frame-inhibit-implied-resize t) | 164 | '(frame-inhibit-implied-resize t) |
| 155 | '(tab-bar-history-mode t) | 165 | '(tab-bar-history-mode t) |
| 156 | '(tab-bar-show 0)) | 166 | '(tab-bar-show 0) |
| 167 | |||
| 168 | ;;;; Programming-related options | ||
| 169 | '(compilation-scroll-output 'first-error)) | ||
| 157 | 170 | ||
| 158 | (provide-theme 'newcomers-presets) | 171 | (provide-theme 'newcomers-presets) |
| 159 | ;;; newcomers-presets-theme.el ends here | 172 | ;;; newcomers-presets-theme.el ends here |
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index b9558ba3da7..a8cdc6e06f9 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c | |||
| @@ -316,6 +316,11 @@ main (int argc, char **argv) | |||
| 316 | SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, | 316 | SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, |
| 317 | SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */); | 317 | SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */); |
| 318 | 318 | ||
| 319 | /* Allow reading the scheduler policy and affinity, so num_processors | ||
| 320 | can determine the number of usable CPUs. */ | ||
| 321 | RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (sched_getaffinity)); | ||
| 322 | RULE0 (SCMP_ACT_ALLOW, SCMP_SYS (sched_getscheduler)); | ||
| 323 | |||
| 319 | /* Block changing resource limits, but don't crash. */ | 324 | /* Block changing resource limits, but don't crash. */ |
| 320 | RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64), | 325 | RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64), |
| 321 | SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, | 326 | SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, |
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index adaa901612a..15dfa2f358f 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el | |||
| @@ -85,6 +85,9 @@ HOST, USER, PORT, REQUIRE, and MAX." | |||
| 85 | ((null host) | 85 | ((null host) |
| 86 | ;; Do not build a result, as none will match when HOST is nil | 86 | ;; Do not build a result, as none will match when HOST is nil |
| 87 | nil) | 87 | nil) |
| 88 | ((not (file-directory-p auth-source-pass-filename)) | ||
| 89 | ;; Do nothing if the password-store folder doesn't exist. | ||
| 90 | nil) | ||
| 88 | (auth-source-pass-extra-query-keywords | 91 | (auth-source-pass-extra-query-keywords |
| 89 | (auth-source-pass--build-result-many host port user require max)) | 92 | (auth-source-pass--build-result-many host port user require max)) |
| 90 | (t | 93 | (t |
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 52677f435ee..87d8ecade54 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -1084,7 +1084,7 @@ even if it doesn't match the type.) | |||
| 1084 | \(fn [VARIABLE VALUE]...)" | 1084 | \(fn [VARIABLE VALUE]...)" |
| 1085 | (declare (debug setq)) | 1085 | (declare (debug setq)) |
| 1086 | (unless (evenp (length pairs)) | 1086 | (unless (evenp (length pairs)) |
| 1087 | (error "PAIRS must have an even number of variable/value members")) | 1087 | (signal 'wrong-number-of-arguments (list 'setopt (length pairs)))) |
| 1088 | (let ((expr nil)) | 1088 | (let ((expr nil)) |
| 1089 | (while pairs | 1089 | (while pairs |
| 1090 | (unless (symbolp (car pairs)) | 1090 | (unless (symbolp (car pairs)) |
| @@ -1100,12 +1100,54 @@ even if it doesn't match the type.) | |||
| 1100 | ;; Check that the type is correct. | 1100 | ;; Check that the type is correct. |
| 1101 | (when-let* ((type (get variable 'custom-type))) | 1101 | (when-let* ((type (get variable 'custom-type))) |
| 1102 | (unless (widget-apply (widget-convert type) :match value) | 1102 | (unless (widget-apply (widget-convert type) :match value) |
| 1103 | (warn "Value `%S' for variable `%s' does not match its type \"%s\"" | 1103 | (warn "Value does not match %S's type `%S': %S" variable type value))) |
| 1104 | value variable type))) | ||
| 1105 | (put variable 'custom-check-value (list value)) | 1104 | (put variable 'custom-check-value (list value)) |
| 1106 | (funcall (or (get variable 'custom-set) #'set-default) variable value)) | 1105 | (funcall (or (get variable 'custom-set) #'set-default) variable value)) |
| 1107 | 1106 | ||
| 1108 | ;;;###autoload | 1107 | ;;;###autoload |
| 1108 | (defmacro setopt-local (&rest pairs) | ||
| 1109 | "Set buffer local VARIABLE/VALUE pairs, and return the final VALUE. | ||
| 1110 | This is like `setq-local', but is meant for user options instead of | ||
| 1111 | plain variables. This means that `setopt-local' will execute any | ||
| 1112 | `custom-set' form associated with VARIABLE. Unlike `setopt', | ||
| 1113 | `setopt-local' does not affect a user option's global value. | ||
| 1114 | |||
| 1115 | Note that `setopt-local' will emit a warning if the type of a VALUE does | ||
| 1116 | not match the type of the corresponding VARIABLE as declared by | ||
| 1117 | `defcustom'. (VARIABLE will be assigned the value even if it doesn't | ||
| 1118 | match the type.) | ||
| 1119 | |||
| 1120 | Signal an error if a `custom-set' form does not support the | ||
| 1121 | `buffer-local' argument. | ||
| 1122 | |||
| 1123 | \(fn [VARIABLE VALUE]...)" | ||
| 1124 | (declare (debug setq)) | ||
| 1125 | (unless (evenp (length pairs)) | ||
| 1126 | (signal 'wrong-number-of-arguments (list 'setopt-local (length pairs)))) | ||
| 1127 | (let ((expr nil)) | ||
| 1128 | (while pairs | ||
| 1129 | (unless (symbolp (car pairs)) | ||
| 1130 | (error "Attempting to set a non-symbol: %s" (car pairs))) | ||
| 1131 | (push `(setopt--set-local ',(car pairs) ,(cadr pairs)) | ||
| 1132 | expr) | ||
| 1133 | (setq pairs (cddr pairs))) | ||
| 1134 | (macroexp-progn (nreverse expr)))) | ||
| 1135 | |||
| 1136 | ;;;###autoload | ||
| 1137 | (defun setopt--set-local (variable value) | ||
| 1138 | (custom-load-symbol variable) | ||
| 1139 | ;; Check that the type is correct. | ||
| 1140 | (when-let* ((type (get variable 'custom-type))) | ||
| 1141 | (unless (widget-apply (widget-convert type) :match value) | ||
| 1142 | (warn "Value does not match %S's type `%S': %S" variable type value))) | ||
| 1143 | (condition-case _ | ||
| 1144 | (funcall (or (get variable 'custom-set) | ||
| 1145 | (lambda (x v &optional _) (set-local x v))) | ||
| 1146 | variable value 'buffer-local) | ||
| 1147 | (wrong-number-of-arguments | ||
| 1148 | (error "The setter of %S does not support setopt-local" variable)))) | ||
| 1149 | |||
| 1150 | ;;;###autoload | ||
| 1109 | (defun customize-save-variable (variable value &optional comment) | 1151 | (defun customize-save-variable (variable value &optional comment) |
| 1110 | "Set the default for VARIABLE to VALUE, and save it for future sessions. | 1152 | "Set the default for VARIABLE to VALUE, and save it for future sessions. |
| 1111 | Return VALUE. | 1153 | Return VALUE. |
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 0e3c8bf6a5f..9fe2904c415 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el | |||
| @@ -398,7 +398,11 @@ then it searches *all* buffers." | |||
| 398 | ;; Set it so `dabbrev-capf' won't reset the vars. | 398 | ;; Set it so `dabbrev-capf' won't reset the vars. |
| 399 | (setq dabbrev--last-abbrev-location (point-marker)) | 399 | (setq dabbrev--last-abbrev-location (point-marker)) |
| 400 | (let ((completion-at-point-functions '(dabbrev-capf))) | 400 | (let ((completion-at-point-functions '(dabbrev-capf))) |
| 401 | (completion-at-point))) | 401 | (unless (completion-at-point) |
| 402 | (user-error "No dynamic expansion for \"%s\" found%s" | ||
| 403 | (dabbrev--abbrev-at-point) | ||
| 404 | (if dabbrev--check-other-buffers | ||
| 405 | "" " in this-buffer"))))) | ||
| 402 | 406 | ||
| 403 | (defun dabbrev-capf () | 407 | (defun dabbrev-capf () |
| 404 | "Dabbrev completion function for `completion-at-point-functions'." | 408 | "Dabbrev completion function for `completion-at-point-functions'." |
diff --git a/lisp/desktop.el b/lisp/desktop.el index f478cf2307b..0cdd554e295 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el | |||
| @@ -775,6 +775,7 @@ if different)." | |||
| 775 | ;; Don't delete daemon's initial frame, or | 775 | ;; Don't delete daemon's initial frame, or |
| 776 | ;; we'll never be able to close the last | 776 | ;; we'll never be able to close the last |
| 777 | ;; client's frame (Bug#26912). | 777 | ;; client's frame (Bug#26912). |
| 778 | ;; Use `frame-initial-p'? | ||
| 778 | (and (daemonp) (eq frame terminal-frame)) | 779 | (and (daemonp) (eq frame terminal-frame)) |
| 779 | (frame-parameter frame 'desktop-dont-clear)) | 780 | (frame-parameter frame 'desktop-dont-clear)) |
| 780 | (delete-frame frame)) | 781 | (delete-frame frame)) |
| @@ -1067,9 +1068,8 @@ DIRNAME must be the directory in which the desktop file will be saved." | |||
| 1067 | (and (not (frame-parameter frame 'desktop-dont-save)) | 1068 | (and (not (frame-parameter frame 'desktop-dont-save)) |
| 1068 | ;; Don't save daemon initial frames, since we cannot (and don't | 1069 | ;; Don't save daemon initial frames, since we cannot (and don't |
| 1069 | ;; need to) restore them. | 1070 | ;; need to) restore them. |
| 1070 | (not (and (daemonp) | 1071 | (not (and (daemonp) ;; FIXME: Remove `daemonp'? |
| 1071 | (equal (terminal-name (frame-terminal frame)) | 1072 | (frame-initial-p frame))))) |
| 1072 | "initial_terminal"))))) | ||
| 1073 | 1073 | ||
| 1074 | (defconst desktop--app-id `(desktop . ,desktop-file-version)) | 1074 | (defconst desktop--app-id `(desktop . ,desktop-file-version)) |
| 1075 | 1075 | ||
| @@ -1260,7 +1260,7 @@ This function also sets `desktop-dirname' to nil." | |||
| 1260 | "True if calling `desktop-restore-frameset' will actually restore it." | 1260 | "True if calling `desktop-restore-frameset' will actually restore it." |
| 1261 | (and desktop-restore-frames desktop-saved-frameset | 1261 | (and desktop-restore-frames desktop-saved-frameset |
| 1262 | ;; Don't restore frames when the selected frame is the daemon's | 1262 | ;; Don't restore frames when the selected frame is the daemon's |
| 1263 | ;; initial frame. | 1263 | ;; initial frame. Use `frame-initial-p'? |
| 1264 | (not (and (daemonp) (eq (selected-frame) terminal-frame))) | 1264 | (not (and (daemonp) (eq (selected-frame) terminal-frame))) |
| 1265 | t)) | 1265 | t)) |
| 1266 | 1266 | ||
diff --git a/lisp/dired.el b/lisp/dired.el index 7f598433a9d..4aded86e40d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -649,6 +649,10 @@ The match starts at the beginning of the line and ends after the end | |||
| 649 | of the line. | 649 | of the line. |
| 650 | Subexpression 2 must end right before the \\n.") | 650 | Subexpression 2 must end right before the \\n.") |
| 651 | 651 | ||
| 652 | (defvar dired--ls-error-buffer nil | ||
| 653 | "Non-nil if the current dired invocation yields an `ls' error. | ||
| 654 | The non-nil value is the buffer containing the error message.") | ||
| 655 | |||
| 652 | 656 | ||
| 653 | ;;; Faces | 657 | ;;; Faces |
| 654 | 658 | ||
| @@ -1230,7 +1234,16 @@ Type \\[describe-mode] after entering Dired for more info. | |||
| 1230 | If DIRNAME is already in a Dired buffer, that buffer is used without refresh." | 1234 | If DIRNAME is already in a Dired buffer, that buffer is used without refresh." |
| 1231 | ;; Cannot use (interactive "D") because of wildcards. | 1235 | ;; Cannot use (interactive "D") because of wildcards. |
| 1232 | (interactive (dired-read-dir-and-switches "")) | 1236 | (interactive (dired-read-dir-and-switches "")) |
| 1233 | (pop-to-buffer-same-window (dired-noselect dirname switches))) | 1237 | (prog1 (pop-to-buffer-same-window (dired-noselect dirname switches)) |
| 1238 | (dired--display-ls-error))) | ||
| 1239 | |||
| 1240 | ;; This is needed to let clicks on the menu bar invoke Dired even if | ||
| 1241 | ;; some feature remaps the Dired command to another command. | ||
| 1242 | ;;;###autoload | ||
| 1243 | (defun dired-from-menubar (dirname &optional switches) | ||
| 1244 | "Edit an existing directory." | ||
| 1245 | (interactive (dired-read-dir-and-switches "")) | ||
| 1246 | (dired dirname switches)) | ||
| 1234 | 1247 | ||
| 1235 | ;;;###autoload (keymap-set ctl-x-4-map "d" #'dired-other-window) | 1248 | ;;;###autoload (keymap-set ctl-x-4-map "d" #'dired-other-window) |
| 1236 | ;;;###autoload | 1249 | ;;;###autoload |
| @@ -1240,21 +1253,24 @@ If this command needs to split the current window, it by default obeys | |||
| 1240 | the user options `split-height-threshold' and `split-width-threshold', | 1253 | the user options `split-height-threshold' and `split-width-threshold', |
| 1241 | when it decides whether to split the window horizontally or vertically." | 1254 | when it decides whether to split the window horizontally or vertically." |
| 1242 | (interactive (dired-read-dir-and-switches "in other window ")) | 1255 | (interactive (dired-read-dir-and-switches "in other window ")) |
| 1243 | (switch-to-buffer-other-window (dired-noselect dirname switches))) | 1256 | (prog1 (switch-to-buffer-other-window (dired-noselect dirname switches)) |
| 1257 | (dired--display-ls-error))) | ||
| 1244 | 1258 | ||
| 1245 | ;;;###autoload (keymap-set ctl-x-5-map "d" #'dired-other-frame) | 1259 | ;;;###autoload (keymap-set ctl-x-5-map "d" #'dired-other-frame) |
| 1246 | ;;;###autoload | 1260 | ;;;###autoload |
| 1247 | (defun dired-other-frame (dirname &optional switches) | 1261 | (defun dired-other-frame (dirname &optional switches) |
| 1248 | "\"Edit\" directory DIRNAME. Like `dired' but make a new frame." | 1262 | "\"Edit\" directory DIRNAME. Like `dired' but make a new frame." |
| 1249 | (interactive (dired-read-dir-and-switches "in other frame ")) | 1263 | (interactive (dired-read-dir-and-switches "in other frame ")) |
| 1250 | (switch-to-buffer-other-frame (dired-noselect dirname switches))) | 1264 | (prog1 (switch-to-buffer-other-frame (dired-noselect dirname switches)) |
| 1265 | (dired--display-ls-error))) | ||
| 1251 | 1266 | ||
| 1252 | ;;;###autoload (keymap-set tab-prefix-map "d" #'dired-other-tab) | 1267 | ;;;###autoload (keymap-set tab-prefix-map "d" #'dired-other-tab) |
| 1253 | ;;;###autoload | 1268 | ;;;###autoload |
| 1254 | (defun dired-other-tab (dirname &optional switches) | 1269 | (defun dired-other-tab (dirname &optional switches) |
| 1255 | "\"Edit\" directory DIRNAME. Like `dired' but make a new tab." | 1270 | "\"Edit\" directory DIRNAME. Like `dired' but make a new tab." |
| 1256 | (interactive (dired-read-dir-and-switches "in other tab ")) | 1271 | (interactive (dired-read-dir-and-switches "in other tab ")) |
| 1257 | (switch-to-buffer-other-tab (dired-noselect dirname switches))) | 1272 | (prog1 (switch-to-buffer-other-tab (dired-noselect dirname switches)) |
| 1273 | (dired--display-ls-error))) | ||
| 1258 | 1274 | ||
| 1259 | ;;;###autoload | 1275 | ;;;###autoload |
| 1260 | (defun dired-noselect (dir-or-list &optional switches) | 1276 | (defun dired-noselect (dir-or-list &optional switches) |
| @@ -1439,10 +1455,19 @@ The return value is the target column for the file names." | |||
| 1439 | (let ((failed t)) | 1455 | (let ((failed t)) |
| 1440 | (unwind-protect | 1456 | (unwind-protect |
| 1441 | (progn (dired-readin) | 1457 | (progn (dired-readin) |
| 1442 | (setq failed nil)) | 1458 | ;; Check for file entries (they are listed below the |
| 1443 | ;; dired-readin can fail if parent directories are inaccessible. | 1459 | ;; directory name and (if present) wildcard lines). |
| 1444 | ;; Don't leave an empty buffer around in that case. | 1460 | (while (and (skip-syntax-forward "\s") |
| 1445 | (if failed (kill-buffer buffer)))) | 1461 | (looking-at "\\(.+:$\\|wildcard\\)")) |
| 1462 | (forward-line)) | ||
| 1463 | (unless (eobp) | ||
| 1464 | (setq failed nil))) | ||
| 1465 | ;; No file entries indicates an `ls' error, and `dired-readin' | ||
| 1466 | ;; can fail if parent directories are inaccessible. In either | ||
| 1467 | ;; case don't leave the Dired buffer around. | ||
| 1468 | (when failed | ||
| 1469 | (kill-buffer buffer) | ||
| 1470 | (setq buffer nil)))) | ||
| 1446 | (goto-char (point-min)) | 1471 | (goto-char (point-min)) |
| 1447 | (dired-initial-position dirname)) | 1472 | (dired-initial-position dirname)) |
| 1448 | (when (consp dired-directory) | 1473 | (when (consp dired-directory) |
| @@ -4003,20 +4028,11 @@ Considers buffers closer to the car of `buffer-list' to be more recent." | |||
| 4003 | (not (memq buffer1 (memq buffer2 (buffer-list)))))) | 4028 | (not (memq buffer1 (memq buffer2 (buffer-list)))))) |
| 4004 | 4029 | ||
| 4005 | (defun dired--filename-with-newline-p () | 4030 | (defun dired--filename-with-newline-p () |
| 4006 | "Check if a file name in this directory has a newline. | 4031 | "Check whether a file name in this directory has a newline. |
| 4007 | Return non-nil if at least one file name in this directory contains | 4032 | Return non-nil if at least one file name in this directory contains a |
| 4008 | either a literal newline or the string \"\\n\")." | 4033 | newline character (regardless of whether Dired displays the character as |
| 4009 | (save-excursion | 4034 | a literal newline or as \"\\n\")." |
| 4010 | (goto-char (point-min)) | 4035 | (directory-files default-directory nil "\n")) |
| 4011 | (catch 'found | ||
| 4012 | (while (not (eobp)) | ||
| 4013 | (when (dired-move-to-filename) | ||
| 4014 | (let ((fn (buffer-substring-no-properties | ||
| 4015 | (point) (dired-move-to-end-of-filename)))) | ||
| 4016 | (when (or (memq 10 (seq-into fn 'list)) | ||
| 4017 | (string-search "\\n" fn)) | ||
| 4018 | (throw 'found t)))) | ||
| 4019 | (forward-line))))) | ||
| 4020 | 4036 | ||
| 4021 | (defun dired--remove-b-switch () | 4037 | (defun dired--remove-b-switch () |
| 4022 | "Remove all variants of the `b' switch from `dired-actual-switches'. | 4038 | "Remove all variants of the `b' switch from `dired-actual-switches'. |
| @@ -4094,6 +4110,13 @@ See `%s' for other alternatives and more information.")) | |||
| 4094 | (set-window-point (get-buffer-window) | 4110 | (set-window-point (get-buffer-window) |
| 4095 | (search-backward "Warning (dired)"))))) | 4111 | (search-backward "Warning (dired)"))))) |
| 4096 | 4112 | ||
| 4113 | (defun dired--display-ls-error () | ||
| 4114 | "Pop up a buffer displaying the current `ls' error, if any." | ||
| 4115 | (when dired--ls-error-buffer | ||
| 4116 | (let* ((errwin (display-buffer dired--ls-error-buffer))) | ||
| 4117 | (fit-window-to-buffer errwin)) | ||
| 4118 | (setq dired--ls-error-buffer nil))) | ||
| 4119 | |||
| 4097 | 4120 | ||
| 4098 | ;;; Deleting files | 4121 | ;;; Deleting files |
| 4099 | 4122 | ||
diff --git a/lisp/display-fill-column-indicator.el b/lisp/display-fill-column-indicator.el index 349a470ab41..b661f20e22a 100644 --- a/lisp/display-fill-column-indicator.el +++ b/lisp/display-fill-column-indicator.el | |||
| @@ -102,6 +102,7 @@ See Info node `Displaying Boundaries' for details." | |||
| 102 | (defun display-fill-column-indicator--turn-on () | 102 | (defun display-fill-column-indicator--turn-on () |
| 103 | "Turn on `display-fill-column-indicator-mode'." | 103 | "Turn on `display-fill-column-indicator-mode'." |
| 104 | (unless (or (minibufferp) | 104 | (unless (or (minibufferp) |
| 105 | ;; Use `frame-initial-p'? | ||
| 105 | (and (daemonp) (eq (selected-frame) terminal-frame))) | 106 | (and (daemonp) (eq (selected-frame) terminal-frame))) |
| 106 | (display-fill-column-indicator-mode))) | 107 | (display-fill-column-indicator-mode))) |
| 107 | 108 | ||
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index ce2d8ac47c4..7ed71346451 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el | |||
| @@ -1901,6 +1901,8 @@ See Info node `(elisp) Integer Basics'." | |||
| 1901 | sqlite-available-p sqlitep | 1901 | sqlite-available-p sqlitep |
| 1902 | ;; syntax.c | 1902 | ;; syntax.c |
| 1903 | standard-syntax-table syntax-table syntax-table-p | 1903 | standard-syntax-table syntax-table syntax-table-p |
| 1904 | ;; terminal.c | ||
| 1905 | frame-initial-p | ||
| 1904 | ;; thread.c | 1906 | ;; thread.c |
| 1905 | current-thread | 1907 | current-thread |
| 1906 | ;; timefns.c | 1908 | ;; timefns.c |
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 3019ada1bbd..ec2aa0ad728 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el | |||
| @@ -195,8 +195,7 @@ the debugger will not be entered." | |||
| 195 | ;; backtrace to stdout. This happens for example while | 195 | ;; backtrace to stdout. This happens for example while |
| 196 | ;; handling an error in code from early-init.el with | 196 | ;; handling an error in code from early-init.el with |
| 197 | ;; --debug-init. | 197 | ;; --debug-init. |
| 198 | (and (eq t (framep (selected-frame))) | 198 | (frame-initial-p))) |
| 199 | (equal "initial_terminal" (terminal-name))))) | ||
| 200 | ;; Don't let `inhibit-message' get in our way (especially important if | 199 | ;; Don't let `inhibit-message' get in our way (especially important if |
| 201 | ;; `non-interactive-frame' evaluated to a non-nil value. | 200 | ;; `non-interactive-frame' evaluated to a non-nil value. |
| 202 | (inhibit-message nil) | 201 | (inhibit-message nil) |
diff --git a/lisp/emacs-lisp/shortdoc-doc.el b/lisp/emacs-lisp/shortdoc-doc.el new file mode 100644 index 00000000000..eb642c1600b --- /dev/null +++ b/lisp/emacs-lisp/shortdoc-doc.el | |||
| @@ -0,0 +1,1528 @@ | |||
| 1 | ;;; shortdoc-doc.el --- Builtin shortdoc groups -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2020-2026 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Keywords: lisp, help | ||
| 6 | ;; Package: emacs | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;; This file defines builtin Emacs shortdoc groups. | ||
| 26 | ;; | ||
| 27 | ;; If a shortdoc group describes builtin functions, functions from | ||
| 28 | ;; subr.el or simple.el or otherwise preloaded files, or functions from | ||
| 29 | ;; different files, then you should probably define it in this file. | ||
| 30 | ;; Otherwise, you might as well define the shortdoc group in the file | ||
| 31 | ;; where the documented functions live, like treesit.el does it. | ||
| 32 | |||
| 33 | ;;; Code: | ||
| 34 | |||
| 35 | (define-short-documentation-group alist | ||
| 36 | "Alist Basics" | ||
| 37 | (assoc | ||
| 38 | :eval (assoc 'foo '((foo . bar) (zot . baz)))) | ||
| 39 | (rassoc | ||
| 40 | :eval (rassoc 'bar '((foo . bar) (zot . baz)))) | ||
| 41 | (assq | ||
| 42 | :eval (assq 'foo '((foo . bar) (zot . baz)))) | ||
| 43 | (rassq | ||
| 44 | :eval (rassq 'bar '((foo . bar) (zot . baz)))) | ||
| 45 | (assoc-string | ||
| 46 | :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) | ||
| 47 | "Manipulating Alists" | ||
| 48 | (assoc-delete-all | ||
| 49 | :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) | ||
| 50 | (assq-delete-all | ||
| 51 | :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) | ||
| 52 | (rassq-delete-all | ||
| 53 | :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) | ||
| 54 | (alist-get | ||
| 55 | :eval (let ((foo '((bar . baz)))) | ||
| 56 | (setf (alist-get 'bar foo) 'zot) | ||
| 57 | foo)) | ||
| 58 | "Misc" | ||
| 59 | (assoc-default | ||
| 60 | :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) | ||
| 61 | (copy-alist | ||
| 62 | :eval (let* ((old '((foo . bar))) | ||
| 63 | (new (copy-alist old))) | ||
| 64 | (eq old new))) | ||
| 65 | ;; FIXME: Outputs "\.rose" for the symbol `.rose'. It would be | ||
| 66 | ;; better if that could be cleaned up. | ||
| 67 | (let-alist | ||
| 68 | :eval (let ((colors '((rose . red) | ||
| 69 | (lily . white)))) | ||
| 70 | (let-alist colors | ||
| 71 | (if (eq .rose 'red) | ||
| 72 | .lily))))) | ||
| 73 | |||
| 74 | (define-short-documentation-group map | ||
| 75 | "Map Basics" | ||
| 76 | (mapp | ||
| 77 | :eval (mapp (list 'bar 1 'foo 2 'baz 3)) | ||
| 78 | :eval (mapp (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 79 | :eval (mapp [bar foo baz]) | ||
| 80 | :eval (mapp "this is a string") | ||
| 81 | :eval (mapp #s(hash-table data (bar 1 foo 2 baz 3))) | ||
| 82 | :eval (mapp '()) | ||
| 83 | :eval (mapp nil) | ||
| 84 | :eval (mapp (make-char-table 'shortdoc-test))) | ||
| 85 | (map-empty-p | ||
| 86 | :args (map) | ||
| 87 | :eval (map-empty-p nil) | ||
| 88 | :eval (map-empty-p []) | ||
| 89 | :eval (map-empty-p '())) | ||
| 90 | (map-elt | ||
| 91 | :args (map key) | ||
| 92 | :eval (map-elt (list 'bar 1 'foo 2 'baz 3) 'foo) | ||
| 93 | :eval (map-elt (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) | ||
| 94 | :eval (map-elt [bar foo baz] 1) | ||
| 95 | :eval (map-elt #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) | ||
| 96 | (map-contains-key | ||
| 97 | :args (map key) | ||
| 98 | :eval (map-contains-key (list 'bar 1 'foo 2 'baz 3) 'foo) | ||
| 99 | :eval (map-contains-key (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) | ||
| 100 | :eval (map-contains-key [bar foo baz] 1) | ||
| 101 | :eval (map-contains-key #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) | ||
| 102 | (map-put! | ||
| 103 | :args (map key value) | ||
| 104 | :eval | ||
| 105 | "(let ((map (list 'bar 1 'baz 3))) | ||
| 106 | (map-put! map 'foo 2) | ||
| 107 | map)" | ||
| 108 | ;; This signals map-not-inplace when used in shortdoc.el :-( | ||
| 109 | ;; :eval | ||
| 110 | ;; "(let ((map (list '(bar . 1) '(baz . 3)))) | ||
| 111 | ;; (map-put! map 'foo 2) | ||
| 112 | ;; map)" | ||
| 113 | :eval | ||
| 114 | "(let ((map [bar bot baz])) | ||
| 115 | (map-put! map 1 'foo) | ||
| 116 | map)" | ||
| 117 | :eval | ||
| 118 | "(let ((map #s(hash-table data (bar 1 baz 3)))) | ||
| 119 | (map-put! map 'foo 2) | ||
| 120 | map)") | ||
| 121 | (map-insert | ||
| 122 | :args (map key value) | ||
| 123 | :eval (map-insert (list 'bar 1 'baz 3 'foo 7) 'foo 2) | ||
| 124 | :eval (map-insert (list '(bar . 1) '(baz . 3) '(foo . 7)) 'foo 2) | ||
| 125 | :eval (map-insert [bar bot baz] 1 'foo) | ||
| 126 | :eval (map-insert #s(hash-table data (bar 1 baz 3 foo 7)) 'foo 2)) | ||
| 127 | (map-delete | ||
| 128 | :args (map key) | ||
| 129 | :eval (map-delete (list 'bar 1 'foo 2 'baz 3) 'foo) | ||
| 130 | :eval (map-delete (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) | ||
| 131 | :eval (map-delete [bar foo baz] 1) | ||
| 132 | :eval (map-delete #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) | ||
| 133 | (map-keys | ||
| 134 | :eval (map-keys (list 'bar 1 'foo 2 'baz 3)) | ||
| 135 | :eval (map-keys (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 136 | :eval (map-keys [bar foo baz]) | ||
| 137 | :eval (map-keys #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 138 | (map-values | ||
| 139 | :args (map) | ||
| 140 | :eval (map-values (list 'bar 1 'foo 2 'baz 3)) | ||
| 141 | :eval (map-values (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 142 | :eval (map-values [bar foo baz]) | ||
| 143 | :eval (map-values #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 144 | (map-pairs | ||
| 145 | :eval (map-pairs (list 'bar 1 'foo 2 'baz 3)) | ||
| 146 | :eval (map-pairs (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 147 | :eval (map-pairs [bar foo baz]) | ||
| 148 | :eval (map-pairs #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 149 | (map-length | ||
| 150 | :args (map) | ||
| 151 | :eval (map-length (list 'bar 1 'foo 2 'baz 3)) | ||
| 152 | :eval (map-length (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 153 | :eval (map-length [bar foo baz]) | ||
| 154 | :eval (map-length #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 155 | (map-copy | ||
| 156 | :args (map) | ||
| 157 | :eval (map-copy (list 'bar 1 'foo 2 'baz 3)) | ||
| 158 | :eval (map-copy (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 159 | :eval (map-copy [bar foo baz]) | ||
| 160 | :eval (map-copy #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 161 | "Doing things to maps and their contents" | ||
| 162 | (map-apply | ||
| 163 | :args (function map) | ||
| 164 | :eval (map-apply #'+ (list '(1 . 2) '(3 . 4)))) | ||
| 165 | (map-do | ||
| 166 | :args (function map) | ||
| 167 | :eval | ||
| 168 | "(let ((map (list '(1 . 1) '(2 . 3))) | ||
| 169 | acc) | ||
| 170 | (map-do (lambda (k v) (push (+ k v) acc)) map) | ||
| 171 | (nreverse acc))") | ||
| 172 | (map-keys-apply | ||
| 173 | :eval (map-keys-apply #'1+ (list '(1 . 2) '(3 . 4)))) | ||
| 174 | (map-values-apply | ||
| 175 | :args (function map) | ||
| 176 | :eval (map-values-apply #'1+ (list '(1 . 2) '(3 . 4)))) | ||
| 177 | (map-filter | ||
| 178 | :eval (map-filter (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) | ||
| 179 | :eval (map-filter (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) | ||
| 180 | (map-remove | ||
| 181 | :eval (map-remove (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) | ||
| 182 | :eval (map-remove (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) | ||
| 183 | (map-some | ||
| 184 | :eval (map-some (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) | ||
| 185 | :eval (map-some (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) | ||
| 186 | (map-every-p | ||
| 187 | :eval (map-every-p (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) | ||
| 188 | :eval (map-every-p (lambda (k v) (evenp (+ k v))) (list '(1 . 3) '(4 . 6)))) | ||
| 189 | "Combining and changing maps" | ||
| 190 | (map-merge | ||
| 191 | :eval (map-merge 'alist '(1 2 3 4) #s(hash-table data (5 6 7 8))) | ||
| 192 | :eval (map-merge 'list '(1 2 3 4) #s(hash-table data (5 6 7 8))) | ||
| 193 | :eval (map-merge 'plist '(1 2 3 4) #s(hash-table data (5 6 7 8))) | ||
| 194 | :eval (map-merge 'hash-table '(1 2 3 4) #s(hash-table data (5 6 7 8)))) | ||
| 195 | (map-merge-with | ||
| 196 | :eval (map-merge-with 'alist #'max '(1 2 3 4) #s(hash-table data (1 1 3 5))) | ||
| 197 | :eval (map-merge-with 'alist #'min '(1 2 3 4) #s(hash-table data (1 1 3 5))) | ||
| 198 | :eval (map-merge-with 'hash-table #'min '(1 2 3 4) #s(hash-table data (1 1 3 5)))) | ||
| 199 | (map-into | ||
| 200 | :args (map type) | ||
| 201 | :eval (map-into #s(hash-table data '(5 6 7 8)) 'list) | ||
| 202 | :eval (map-into '((5 . 6) (7 . 8)) 'plist) | ||
| 203 | :eval (map-into '((5 . 6) (7 . 8)) 'hash-table))) | ||
| 204 | |||
| 205 | (define-short-documentation-group string | ||
| 206 | "Making Strings" | ||
| 207 | (make-string | ||
| 208 | :args (length init) | ||
| 209 | :eval "(make-string 5 ?x)") | ||
| 210 | (string | ||
| 211 | :eval "(string ?a ?b ?c)") | ||
| 212 | (concat | ||
| 213 | :eval (concat "foo" "bar" "zot")) | ||
| 214 | (string-join | ||
| 215 | :no-manual t | ||
| 216 | :eval (string-join '("foo" "bar" "zot") " ")) | ||
| 217 | (mapconcat | ||
| 218 | :eval (mapconcat (lambda (a) (concat "[" a "]")) | ||
| 219 | '("foo" "bar" "zot") " ")) | ||
| 220 | (string-pad | ||
| 221 | :eval (string-pad "foo" 5) | ||
| 222 | :eval (string-pad "foobar" 5) | ||
| 223 | :eval (string-pad "foo" 5 ?- t)) | ||
| 224 | (mapcar | ||
| 225 | :eval (mapcar #'identity "123")) | ||
| 226 | (format | ||
| 227 | :eval (format "This number is %d" 4)) | ||
| 228 | "Manipulating Strings" | ||
| 229 | (substring | ||
| 230 | :eval (substring "abcde" 1 3) | ||
| 231 | :eval (substring "abcde" 2) | ||
| 232 | :eval (substring "abcde" 1 -1) | ||
| 233 | :eval (substring "abcde" -4 4)) | ||
| 234 | (string-limit | ||
| 235 | :eval (string-limit "foobar" 3) | ||
| 236 | :eval (string-limit "foobar" 3 t) | ||
| 237 | :eval (string-limit "foobar" 10) | ||
| 238 | :eval (string-limit "fo好" 3 nil 'utf-8)) | ||
| 239 | (truncate-string-to-width | ||
| 240 | :eval (truncate-string-to-width "foobar" 3) | ||
| 241 | :eval (truncate-string-to-width "你好bar" 5)) | ||
| 242 | (split-string | ||
| 243 | :eval (split-string "foo bar") | ||
| 244 | :eval (split-string "|foo|bar|" "|") | ||
| 245 | :eval (split-string "|foo|bar|" "|" t)) | ||
| 246 | (split-string-and-unquote | ||
| 247 | :eval (split-string-and-unquote "foo \"bar zot\"")) | ||
| 248 | (split-string-shell-command | ||
| 249 | :eval (split-string-shell-command "ls /tmp/'foo bar'")) | ||
| 250 | (string-lines | ||
| 251 | :eval (string-lines "foo\n\nbar") | ||
| 252 | :eval (string-lines "foo\n\nbar" t)) | ||
| 253 | (string-replace | ||
| 254 | :eval (string-replace "foo" "bar" "foozot")) | ||
| 255 | (replace-regexp-in-string | ||
| 256 | :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) | ||
| 257 | (string-trim | ||
| 258 | :args (string) | ||
| 259 | :doc "Trim STRING of leading and trailing white space." | ||
| 260 | :eval (string-trim " foo ")) | ||
| 261 | (string-trim-left | ||
| 262 | :eval (string-trim-left "oofoo" "o+")) | ||
| 263 | (string-trim-right | ||
| 264 | :eval (string-trim-right "barkss" "s+")) | ||
| 265 | (string-truncate-left | ||
| 266 | :no-manual t | ||
| 267 | :eval (string-truncate-left "longstring" 8)) | ||
| 268 | (string-remove-suffix | ||
| 269 | :no-manual t | ||
| 270 | :eval (string-remove-suffix "bar" "foobar")) | ||
| 271 | (string-remove-prefix | ||
| 272 | :no-manual t | ||
| 273 | :eval (string-remove-prefix "foo" "foobar")) | ||
| 274 | (string-chop-newline | ||
| 275 | :eval (string-chop-newline "foo\n")) | ||
| 276 | (string-clean-whitespace | ||
| 277 | :eval (string-clean-whitespace " foo bar ")) | ||
| 278 | (string-fill | ||
| 279 | :eval (string-fill "Three short words" 12) | ||
| 280 | :eval (string-fill "Long-word" 3)) | ||
| 281 | (reverse | ||
| 282 | :eval (reverse "foo")) | ||
| 283 | (substring-no-properties | ||
| 284 | :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3)) | ||
| 285 | (try-completion | ||
| 286 | :eval (try-completion "foo" '("foobar" "foozot" "gazonk"))) | ||
| 287 | "Unicode Strings" | ||
| 288 | (string-glyph-split | ||
| 289 | :eval (string-glyph-split "Hello, 👼🏻🧑🏼🤝🧑🏻")) | ||
| 290 | (string-glyph-compose | ||
| 291 | :eval (string-glyph-compose "Å")) | ||
| 292 | (string-glyph-decompose | ||
| 293 | :eval (string-glyph-decompose "Å")) | ||
| 294 | "Predicates for Strings" | ||
| 295 | (string-equal | ||
| 296 | :eval (string-equal "abc" "abc") | ||
| 297 | :eval (string-equal "abc" "ABC")) | ||
| 298 | (string-equal-ignore-case | ||
| 299 | :eval (string-equal-ignore-case "foo" "FOO")) | ||
| 300 | (equal | ||
| 301 | :eval (equal "foo" "foo")) | ||
| 302 | (cl-equalp | ||
| 303 | :eval (cl-equalp "Foo" "foo")) | ||
| 304 | (stringp | ||
| 305 | :eval (stringp "a") | ||
| 306 | :eval (stringp 'a) | ||
| 307 | :eval "(stringp ?a)") | ||
| 308 | (string-or-null-p | ||
| 309 | :eval (string-or-null-p "a") | ||
| 310 | :eval (string-or-null-p nil)) | ||
| 311 | (char-or-string-p | ||
| 312 | :eval "(char-or-string-p ?a)" | ||
| 313 | :eval (char-or-string-p "a")) | ||
| 314 | (string-empty-p | ||
| 315 | :no-manual t | ||
| 316 | :eval (string-empty-p "")) | ||
| 317 | (string-blank-p | ||
| 318 | :no-manual t | ||
| 319 | :eval (string-blank-p " \n")) | ||
| 320 | (string-lessp | ||
| 321 | :eval (string-lessp "abc" "def") | ||
| 322 | :eval (string-lessp "pic4.png" "pic32.png") | ||
| 323 | :eval (string-lessp "1.1" "1.2")) | ||
| 324 | (string-greaterp | ||
| 325 | :eval (string-greaterp "foo" "bar")) | ||
| 326 | (string-version-lessp | ||
| 327 | :eval (string-version-lessp "pic4.png" "pic32.png") | ||
| 328 | :eval (string-version-lessp "1.9.3" "1.10.2")) | ||
| 329 | (string-collate-lessp | ||
| 330 | :eval (string-collate-lessp "abc" "abd")) | ||
| 331 | (string-prefix-p | ||
| 332 | :eval (string-prefix-p "foo" "foobar")) | ||
| 333 | (string-suffix-p | ||
| 334 | :eval (string-suffix-p "bar" "foobar")) | ||
| 335 | "Case Manipulation" | ||
| 336 | (upcase | ||
| 337 | :eval (upcase "foo")) | ||
| 338 | (downcase | ||
| 339 | :eval (downcase "FOObar")) | ||
| 340 | (capitalize | ||
| 341 | :eval (capitalize "foo bar zot")) | ||
| 342 | (upcase-initials | ||
| 343 | :eval (upcase-initials "The CAT in the hAt")) | ||
| 344 | "Converting Strings" | ||
| 345 | (string-to-number | ||
| 346 | :eval (string-to-number "42") | ||
| 347 | :eval (string-to-number "deadbeef" 16) | ||
| 348 | :eval (string-to-number "2.5e+03")) | ||
| 349 | (number-to-string | ||
| 350 | :eval (number-to-string 42)) | ||
| 351 | (char-uppercase-p | ||
| 352 | :eval "(char-uppercase-p ?A)" | ||
| 353 | :eval "(char-uppercase-p ?a)") | ||
| 354 | "Data About Strings" | ||
| 355 | (length | ||
| 356 | :eval (length "foo") | ||
| 357 | :eval (length "avocado: 🥑")) | ||
| 358 | (string-width | ||
| 359 | :eval (string-width "foo") | ||
| 360 | :eval (string-width "avocado: 🥑")) | ||
| 361 | (string-pixel-width | ||
| 362 | :eval (string-pixel-width "foo") | ||
| 363 | :eval (string-pixel-width "avocado: 🥑")) | ||
| 364 | (string-search | ||
| 365 | :eval (string-search "bar" "foobarzot")) | ||
| 366 | (assoc-string | ||
| 367 | :eval (assoc-string "foo" '(("a" 1) (foo 2)))) | ||
| 368 | (seq-position | ||
| 369 | :eval "(seq-position \"foobarzot\" ?z)")) | ||
| 370 | |||
| 371 | (define-short-documentation-group file-name | ||
| 372 | "File Name Manipulation" | ||
| 373 | (file-name-directory | ||
| 374 | :eval (file-name-directory "/tmp/foo") | ||
| 375 | :eval (file-name-directory "/tmp/foo/")) | ||
| 376 | (file-name-nondirectory | ||
| 377 | :eval (file-name-nondirectory "/tmp/foo") | ||
| 378 | :eval (file-name-nondirectory "/tmp/foo/")) | ||
| 379 | (file-name-sans-versions | ||
| 380 | :args (filename) | ||
| 381 | :eval (file-name-sans-versions "/tmp/foo~")) | ||
| 382 | (file-name-extension | ||
| 383 | :eval (file-name-extension "/tmp/foo.txt")) | ||
| 384 | (file-name-sans-extension | ||
| 385 | :eval (file-name-sans-extension "/tmp/foo.txt")) | ||
| 386 | (file-name-with-extension | ||
| 387 | :eval (file-name-with-extension "foo.txt" "bin") | ||
| 388 | :eval (file-name-with-extension "foo" "bin")) | ||
| 389 | (file-name-base | ||
| 390 | :eval (file-name-base "/tmp/foo.txt")) | ||
| 391 | (file-relative-name | ||
| 392 | :eval (file-relative-name "/tmp/foo" "/tmp")) | ||
| 393 | (file-name-split | ||
| 394 | :eval (file-name-split "/tmp/foo") | ||
| 395 | :eval (file-name-split "foo/bar")) | ||
| 396 | (make-temp-name | ||
| 397 | :eval (make-temp-name "/tmp/foo-")) | ||
| 398 | (file-name-concat | ||
| 399 | :eval (file-name-concat "/tmp/" "foo") | ||
| 400 | :eval (file-name-concat "/tmp" "foo") | ||
| 401 | :eval (file-name-concat "/tmp" "foo" "bar/" "zot") | ||
| 402 | :eval (file-name-concat "/tmp" "~")) | ||
| 403 | (expand-file-name | ||
| 404 | :eval (expand-file-name "foo" "/tmp/") | ||
| 405 | :eval (expand-file-name "foo" "/tmp///") | ||
| 406 | :eval (expand-file-name "foo" "/tmp/foo/.././") | ||
| 407 | :eval (expand-file-name "~" "/tmp/")) | ||
| 408 | (substitute-in-file-name | ||
| 409 | :eval (substitute-in-file-name "$HOME/foo")) | ||
| 410 | "Directory Functions" | ||
| 411 | (file-name-as-directory | ||
| 412 | :eval (file-name-as-directory "/tmp/foo")) | ||
| 413 | (directory-file-name | ||
| 414 | :eval (directory-file-name "/tmp/foo/")) | ||
| 415 | (abbreviate-file-name | ||
| 416 | :no-eval (abbreviate-file-name "/home/some-user") | ||
| 417 | :eg-result "~some-user") | ||
| 418 | (file-name-parent-directory | ||
| 419 | :eval (file-name-parent-directory "/foo/bar") | ||
| 420 | :eval (file-name-parent-directory "/foo/") | ||
| 421 | :eval (file-name-parent-directory "foo/bar") | ||
| 422 | :eval (file-name-parent-directory "foo")) | ||
| 423 | "Quoted File Names" | ||
| 424 | (file-name-quote | ||
| 425 | :args (name) | ||
| 426 | :eval (file-name-quote "/tmp/foo")) | ||
| 427 | (file-name-unquote | ||
| 428 | :args (name) | ||
| 429 | :eval (file-name-unquote "/:/tmp/foo")) | ||
| 430 | "Predicates" | ||
| 431 | (file-name-absolute-p | ||
| 432 | :eval (file-name-absolute-p "/tmp/foo") | ||
| 433 | :eval (file-name-absolute-p "foo")) | ||
| 434 | (directory-name-p | ||
| 435 | :eval (directory-name-p "/tmp/foo/")) | ||
| 436 | (file-name-quoted-p | ||
| 437 | :eval (file-name-quoted-p "/:/tmp/foo"))) | ||
| 438 | |||
| 439 | (define-short-documentation-group file | ||
| 440 | "Inserting Contents" | ||
| 441 | (insert-file-contents | ||
| 442 | :no-eval (insert-file-contents "/tmp/foo") | ||
| 443 | :eg-result ("/tmp/foo" 6)) | ||
| 444 | (insert-file-contents-literally | ||
| 445 | :no-eval (insert-file-contents-literally "/tmp/foo") | ||
| 446 | :eg-result ("/tmp/foo" 6)) | ||
| 447 | (find-file | ||
| 448 | :no-eval (find-file "/tmp/foo") | ||
| 449 | :eg-result-string "#<buffer foo>") | ||
| 450 | "Predicates" | ||
| 451 | (file-symlink-p | ||
| 452 | :no-eval (file-symlink-p "/tmp/foo") | ||
| 453 | :eg-result t) | ||
| 454 | (file-directory-p | ||
| 455 | :no-eval (file-directory-p "/tmp") | ||
| 456 | :eg-result t) | ||
| 457 | (file-regular-p | ||
| 458 | :no-eval (file-regular-p "/tmp/foo") | ||
| 459 | :eg-result t) | ||
| 460 | (file-exists-p | ||
| 461 | :no-eval (file-exists-p "/tmp/foo") | ||
| 462 | :eg-result t) | ||
| 463 | (file-readable-p | ||
| 464 | :no-eval (file-readable-p "/tmp/foo") | ||
| 465 | :eg-result t) | ||
| 466 | (file-writable-p | ||
| 467 | :no-eval (file-writable-p "/tmp/foo") | ||
| 468 | :eg-result t) | ||
| 469 | (file-accessible-directory-p | ||
| 470 | :no-eval (file-accessible-directory-p "/tmp") | ||
| 471 | :eg-result t) | ||
| 472 | (file-executable-p | ||
| 473 | :no-eval (file-executable-p "/bin/cat") | ||
| 474 | :eg-result t) | ||
| 475 | (file-newer-than-file-p | ||
| 476 | :no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar") | ||
| 477 | :eg-result nil) | ||
| 478 | (file-has-changed-p | ||
| 479 | :no-eval (file-has-changed-p "/tmp/foo") | ||
| 480 | :eg-result t) | ||
| 481 | (file-equal-p | ||
| 482 | :no-eval (file-equal-p "/tmp/foo" "/tmp/bar") | ||
| 483 | :eg-result nil) | ||
| 484 | (file-in-directory-p | ||
| 485 | :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") | ||
| 486 | :eg-result t) | ||
| 487 | (file-locked-p | ||
| 488 | :no-eval (file-locked-p "/tmp/foo") | ||
| 489 | :eg-result nil) | ||
| 490 | "Information" | ||
| 491 | (file-attributes | ||
| 492 | :no-eval* (file-attributes "/tmp")) | ||
| 493 | (file-truename | ||
| 494 | :no-eval (file-truename "/tmp/foo/bar") | ||
| 495 | :eg-result "/tmp/foo/zot") | ||
| 496 | (file-chase-links | ||
| 497 | :no-eval (file-chase-links "/tmp/foo/bar") | ||
| 498 | :eg-result "/tmp/foo/zot") | ||
| 499 | (vc-responsible-backend | ||
| 500 | :args (file &optional no-error) | ||
| 501 | :no-eval (vc-responsible-backend "/src/foo/bar.c") | ||
| 502 | :eg-result Git) | ||
| 503 | (file-acl | ||
| 504 | :no-eval (file-acl "/tmp/foo") | ||
| 505 | :eg-result "user::rw-\ngroup::r--\nother::r--\n") | ||
| 506 | (file-extended-attributes | ||
| 507 | :no-eval* (file-extended-attributes "/tmp/foo")) | ||
| 508 | (file-selinux-context | ||
| 509 | :no-eval* (file-selinux-context "/tmp/foo")) | ||
| 510 | (locate-file | ||
| 511 | :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) | ||
| 512 | :eg-result "/var/log/syslog") | ||
| 513 | (executable-find | ||
| 514 | :no-eval (executable-find "ls") | ||
| 515 | :eg-result "/usr/bin/ls") | ||
| 516 | "Creating" | ||
| 517 | (make-temp-file | ||
| 518 | :no-eval (make-temp-file "/tmp/foo-") | ||
| 519 | :eg-result "/tmp/foo-ZcXFMj") | ||
| 520 | (make-nearby-temp-file | ||
| 521 | :no-eval (make-nearby-temp-file "/tmp/foo-") | ||
| 522 | :eg-result "/tmp/foo-xe8iON") | ||
| 523 | (write-region | ||
| 524 | :no-value (write-region (point-min) (point-max) "/tmp/foo")) | ||
| 525 | "Directories" | ||
| 526 | (make-directory | ||
| 527 | :no-value (make-directory "/tmp/bar/zot/" t)) | ||
| 528 | (directory-files | ||
| 529 | :no-eval (directory-files "/tmp/") | ||
| 530 | :eg-result ("." ".." ".ICE-unix" ".Test-unix")) | ||
| 531 | (directory-files-recursively | ||
| 532 | :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") | ||
| 533 | :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) | ||
| 534 | (directory-files-and-attributes | ||
| 535 | :no-eval* (directory-files-and-attributes "/tmp/foo")) | ||
| 536 | (file-expand-wildcards | ||
| 537 | :no-eval (file-expand-wildcards "/tmp/*.png") | ||
| 538 | :eg-result ("/tmp/foo.png" "/tmp/zot.png") | ||
| 539 | :no-eval (file-expand-wildcards "/*/foo.png") | ||
| 540 | :eg-result ("/tmp/foo.png" "/var/foo.png")) | ||
| 541 | (locate-dominating-file | ||
| 542 | :no-eval (locate-dominating-file "foo.png" "/tmp/foo/bar/zot") | ||
| 543 | :eg-result "/tmp/foo.png") | ||
| 544 | (copy-directory | ||
| 545 | :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) | ||
| 546 | (delete-directory | ||
| 547 | :no-value (delete-directory "/tmp/bar/")) | ||
| 548 | "File Operations" | ||
| 549 | (rename-file | ||
| 550 | :no-value (rename-file "/tmp/foo" "/tmp/newname")) | ||
| 551 | (copy-file | ||
| 552 | :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) | ||
| 553 | (delete-file | ||
| 554 | :no-value (delete-file "/tmp/foo")) | ||
| 555 | (make-empty-file | ||
| 556 | :no-value (make-empty-file "/tmp/foo")) | ||
| 557 | (make-symbolic-link | ||
| 558 | :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) | ||
| 559 | (add-name-to-file | ||
| 560 | :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) | ||
| 561 | (set-file-modes | ||
| 562 | :no-value "(set-file-modes \"/tmp/foo\" #o644)") | ||
| 563 | (set-file-times | ||
| 564 | :no-value (set-file-times "/tmp/foo")) | ||
| 565 | "File Modes" | ||
| 566 | (set-default-file-modes | ||
| 567 | :no-value "(set-default-file-modes #o755)") | ||
| 568 | (default-file-modes | ||
| 569 | :no-eval (default-file-modes) | ||
| 570 | :eg-result-string "#o755") | ||
| 571 | (file-modes-symbolic-to-number | ||
| 572 | :no-eval (file-modes-symbolic-to-number "a+r") | ||
| 573 | :eg-result-string "#o444") | ||
| 574 | (file-modes-number-to-symbolic | ||
| 575 | :eval "(file-modes-number-to-symbolic #o444)") | ||
| 576 | (set-file-extended-attributes | ||
| 577 | :no-eval (set-file-extended-attributes | ||
| 578 | "/tmp/foo" '((acl . "group::rxx"))) | ||
| 579 | :eg-result t) | ||
| 580 | (set-file-selinux-context | ||
| 581 | :no-eval (set-file-selinux-context | ||
| 582 | "/tmp/foo" '(unconfined_u object_r user_home_t s0)) | ||
| 583 | :eg-result t) | ||
| 584 | (set-file-acl | ||
| 585 | :no-eval (set-file-acl "/tmp/foo" "group::rxx") | ||
| 586 | :eg-result t)) | ||
| 587 | |||
| 588 | (define-short-documentation-group hash-table | ||
| 589 | "Hash Table Basics" | ||
| 590 | (make-hash-table | ||
| 591 | :no-eval (make-hash-table) | ||
| 592 | :result-string "#s(hash-table ...)") | ||
| 593 | (puthash | ||
| 594 | :no-eval (puthash 'key "value" table)) | ||
| 595 | (gethash | ||
| 596 | :no-eval (gethash 'key table) | ||
| 597 | :eg-result "value") | ||
| 598 | (remhash | ||
| 599 | :no-eval (remhash 'key table) | ||
| 600 | :result nil) | ||
| 601 | (clrhash | ||
| 602 | :no-eval (clrhash table) | ||
| 603 | :result-string "#s(hash-table ...)") | ||
| 604 | (maphash | ||
| 605 | :no-eval (maphash (lambda (key value) (message value)) table) | ||
| 606 | :result nil) | ||
| 607 | "Other Hash Table Functions" | ||
| 608 | (hash-table-p | ||
| 609 | :eval (hash-table-p 123)) | ||
| 610 | (hash-table-contains-p | ||
| 611 | :no-eval (hash-table-contains-p 'key table)) | ||
| 612 | (copy-hash-table | ||
| 613 | :no-eval (copy-hash-table table) | ||
| 614 | :result-string "#s(hash-table ...)") | ||
| 615 | (hash-table-count | ||
| 616 | :no-eval (hash-table-count table) | ||
| 617 | :eg-result 15)) | ||
| 618 | |||
| 619 | (define-short-documentation-group list | ||
| 620 | "Making Lists" | ||
| 621 | (make-list | ||
| 622 | :eval (make-list 5 'a)) | ||
| 623 | (cons | ||
| 624 | :eval (cons 1 '(2 3 4))) | ||
| 625 | (list | ||
| 626 | :eval (list 1 2 3)) | ||
| 627 | (number-sequence | ||
| 628 | :eval (number-sequence 5 8)) | ||
| 629 | (ensure-list | ||
| 630 | :eval (ensure-list "foo") | ||
| 631 | :eval (ensure-list '(1 2 3)) | ||
| 632 | :eval (ensure-list '(1 . 2))) | ||
| 633 | (ensure-proper-list | ||
| 634 | :eval (ensure-proper-list "foo") | ||
| 635 | :eval (ensure-proper-list '(1 2 3)) | ||
| 636 | :eval (ensure-proper-list '(1 . 2))) | ||
| 637 | "Operations on Lists" | ||
| 638 | (append | ||
| 639 | :eval (append '("foo" "bar") '("zot"))) | ||
| 640 | (copy-tree | ||
| 641 | :eval (copy-tree '(1 (2 3) 4))) | ||
| 642 | (flatten-tree | ||
| 643 | :eval (flatten-tree '(1 (2 3) 4))) | ||
| 644 | (car | ||
| 645 | :eval (car '(one two three)) | ||
| 646 | :eval (car '(one . two)) | ||
| 647 | :eval (car nil)) | ||
| 648 | (cdr | ||
| 649 | :eval (cdr '(one two three)) | ||
| 650 | :eval (cdr '(one . two)) | ||
| 651 | :eval (cdr nil)) | ||
| 652 | (last | ||
| 653 | :eval (last '(one two three))) | ||
| 654 | (butlast | ||
| 655 | :eval (butlast '(one two three))) | ||
| 656 | (nbutlast | ||
| 657 | :eval (nbutlast (list 'one 'two 'three))) | ||
| 658 | (nth | ||
| 659 | :eval (nth 1 '(one two three))) | ||
| 660 | (nthcdr | ||
| 661 | :eval (nthcdr 1 '(one two three))) | ||
| 662 | (take | ||
| 663 | :eval (take 3 '(one two three four))) | ||
| 664 | (ntake | ||
| 665 | :eval (ntake 3 (list 'one 'two 'three 'four))) | ||
| 666 | (take-while | ||
| 667 | :eval (take-while #'numberp '(1 2 three 4 five))) | ||
| 668 | (drop-while | ||
| 669 | :eval (drop-while #'numberp '(1 2 three 4 five))) | ||
| 670 | (any | ||
| 671 | :eval (any #'symbolp '(1 2 three 4 five))) | ||
| 672 | (all | ||
| 673 | :eval (all #'symbolp '(one 2 three)) | ||
| 674 | :eval (all #'symbolp '(one two three))) | ||
| 675 | (elt | ||
| 676 | :eval (elt '(one two three) 1)) | ||
| 677 | (car-safe | ||
| 678 | :eval (car-safe '(one two three))) | ||
| 679 | (cdr-safe | ||
| 680 | :eval (cdr-safe '(one two three))) | ||
| 681 | (push | ||
| 682 | :no-eval* (push 'a list)) | ||
| 683 | (pop | ||
| 684 | :no-eval* (pop list)) | ||
| 685 | (setcar | ||
| 686 | :no-eval (setcar list 'c) | ||
| 687 | :result c) | ||
| 688 | (setcdr | ||
| 689 | :no-eval (setcdr list (list c)) | ||
| 690 | :result '(c)) | ||
| 691 | (nconc | ||
| 692 | :eval (nconc (list 1) (list 2 3 4))) | ||
| 693 | (delq | ||
| 694 | :eval (delq 'a (list 'a 'b 'c 'd))) | ||
| 695 | (delete | ||
| 696 | :eval (delete 2 (list 1 2 3 4)) | ||
| 697 | :eval (delete "a" (list "a" "b" "c" "d"))) | ||
| 698 | (remq | ||
| 699 | :eval (remq 'b '(a b c))) | ||
| 700 | (remove | ||
| 701 | :eval (remove 2 '(1 2 3 4)) | ||
| 702 | :eval (remove "a" '("a" "b" "c" "d"))) | ||
| 703 | (delete-dups | ||
| 704 | :eval (delete-dups (list 1 2 4 3 2 4))) | ||
| 705 | "Mapping Over Lists" | ||
| 706 | (mapcar | ||
| 707 | :eval (mapcar #'list '(1 2 3))) | ||
| 708 | (mapcan | ||
| 709 | :eval (mapcan #'list '(1 2 3))) | ||
| 710 | (mapc | ||
| 711 | :eval (mapc #'insert '("1" "2" "3"))) | ||
| 712 | (seq-reduce | ||
| 713 | :eval (seq-reduce #'+ '(1 2 3) 0)) | ||
| 714 | (mapconcat | ||
| 715 | :eval (mapconcat #'identity '("foo" "bar") "|")) | ||
| 716 | "Predicates" | ||
| 717 | (listp | ||
| 718 | :eval (listp '(1 2 3)) | ||
| 719 | :eval (listp nil) | ||
| 720 | :eval (listp '(1 . 2))) | ||
| 721 | (consp | ||
| 722 | :eval (consp '(1 2 3)) | ||
| 723 | :eval (consp nil)) | ||
| 724 | (proper-list-p | ||
| 725 | :eval (proper-list-p '(1 2 3)) | ||
| 726 | :eval (proper-list-p nil) | ||
| 727 | :eval (proper-list-p '(1 . 2))) | ||
| 728 | (null | ||
| 729 | :eval (null nil)) | ||
| 730 | (atom | ||
| 731 | :eval (atom 'a)) | ||
| 732 | (nlistp | ||
| 733 | :eval (nlistp '(1 2 3)) | ||
| 734 | :eval (nlistp t) | ||
| 735 | :eval (nlistp '(1 . 2))) | ||
| 736 | "Finding Elements" | ||
| 737 | (memq | ||
| 738 | :eval (memq 'b '(a b c))) | ||
| 739 | (memql | ||
| 740 | :eval (memql 2.0 '(1.0 2.0 3.0))) | ||
| 741 | (member | ||
| 742 | :eval (member 2 '(1 2 3)) | ||
| 743 | :eval (member "b" '("a" "b" "c"))) | ||
| 744 | (member-ignore-case | ||
| 745 | :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) | ||
| 746 | "Association Lists" | ||
| 747 | (assoc | ||
| 748 | :eval (assoc "b" '(("a" . 1) ("b" . 2)))) | ||
| 749 | (rassoc | ||
| 750 | :eval (rassoc "b" '((1 . "a") (2 . "b")))) | ||
| 751 | (assq | ||
| 752 | :eval (assq 'b '((a . 1) (b . 2)))) | ||
| 753 | (rassq | ||
| 754 | :eval (rassq 'b '((1 . a) (2 . b)))) | ||
| 755 | (assoc-string | ||
| 756 | :eval (assoc-string "foo" '(("a" 1) (foo 2)))) | ||
| 757 | (alist-get | ||
| 758 | :eval (alist-get 2 '((1 . a) (2 . b)))) | ||
| 759 | (assoc-default | ||
| 760 | :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) | ||
| 761 | (copy-alist | ||
| 762 | :eval (copy-alist '((1 . a) (2 . b)))) | ||
| 763 | (assoc-delete-all | ||
| 764 | :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) | ||
| 765 | (assq-delete-all | ||
| 766 | :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) | ||
| 767 | (rassq-delete-all | ||
| 768 | :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) | ||
| 769 | "Property Lists" | ||
| 770 | (plist-get | ||
| 771 | :eval (plist-get '(a 1 b 2 c 3) 'b)) | ||
| 772 | (plist-put | ||
| 773 | :no-eval (setq plist (plist-put plist 'd 4)) | ||
| 774 | :eg-result (a 1 b 2 c 3 d 4)) | ||
| 775 | (plist-member | ||
| 776 | :eval (plist-member '(a 1 b 2 c 3) 'b)) | ||
| 777 | "Data About Lists" | ||
| 778 | (length | ||
| 779 | :eval (length '(a b c))) | ||
| 780 | (length< | ||
| 781 | :eval (length< '(a b c) 1)) | ||
| 782 | (length> | ||
| 783 | :eval (length> '(a b c) 1)) | ||
| 784 | (length= | ||
| 785 | :eval (length= '(a b c) 3)) | ||
| 786 | (safe-length | ||
| 787 | :eval (safe-length '(a b c)))) | ||
| 788 | |||
| 789 | (define-short-documentation-group symbol | ||
| 790 | "Making symbols" | ||
| 791 | (intern | ||
| 792 | :eval (intern "abc")) | ||
| 793 | (intern-soft | ||
| 794 | :eval (intern-soft "list") | ||
| 795 | :eval (intern-soft "Phooey!")) | ||
| 796 | (make-symbol | ||
| 797 | :eval (make-symbol "abc")) | ||
| 798 | (gensym | ||
| 799 | :no-eval (gensym) | ||
| 800 | :eg-result g37) | ||
| 801 | "Comparing symbols" | ||
| 802 | (eq | ||
| 803 | :eval (eq 'abc 'abc) | ||
| 804 | :eval (eq 'abc 'abd)) | ||
| 805 | (eql | ||
| 806 | :eval (eql 'abc 'abc)) | ||
| 807 | (equal | ||
| 808 | :eval (equal 'abc 'abc)) | ||
| 809 | "Name" | ||
| 810 | (symbol-name | ||
| 811 | :eval (symbol-name 'abc)) | ||
| 812 | "Obarrays" | ||
| 813 | (obarray-make | ||
| 814 | :eval (obarray-make)) | ||
| 815 | (obarrayp | ||
| 816 | :eval (obarrayp (obarray-make)) | ||
| 817 | :eval (obarrayp nil)) | ||
| 818 | (unintern | ||
| 819 | :no-eval (unintern "abc" my-obarray) | ||
| 820 | :eg-result t) | ||
| 821 | (mapatoms | ||
| 822 | :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) | ||
| 823 | (obarray-clear | ||
| 824 | :no-eval (obarray-clear my-obarray))) | ||
| 825 | |||
| 826 | (define-short-documentation-group comparison | ||
| 827 | "General-purpose" | ||
| 828 | (eq | ||
| 829 | :eval (eq 'a 'a) | ||
| 830 | :eval "(eq ?A ?A)" | ||
| 831 | :eval (let ((x (list 'a "b" '(c) 4 5.0))) | ||
| 832 | (eq x x))) | ||
| 833 | (eql | ||
| 834 | :eval (eql 2 2) | ||
| 835 | :eval (eql 2.0 2.0) | ||
| 836 | :eval (eql 2.0 2)) | ||
| 837 | (equal | ||
| 838 | :eval (equal "abc" "abc") | ||
| 839 | :eval (equal 2.0 2.0) | ||
| 840 | :eval (equal 2.0 2) | ||
| 841 | :eval (equal '(a "b" (c) 4.0) '(a "b" (c) 4.0))) | ||
| 842 | (cl-equalp | ||
| 843 | :eval (cl-equalp 2 2.0) | ||
| 844 | :eval (cl-equalp "ABC" "abc")) | ||
| 845 | "Numeric" | ||
| 846 | (= | ||
| 847 | :args (number &rest numbers) | ||
| 848 | :eval (= 2 2) | ||
| 849 | :eval (= 2.0 2.0) | ||
| 850 | :eval (= 2.0 2) | ||
| 851 | :eval (= 4 4 4 4)) | ||
| 852 | (/= | ||
| 853 | :eval (/= 4 4)) | ||
| 854 | (< | ||
| 855 | :args (number &rest numbers) | ||
| 856 | :eval (< 4 4) | ||
| 857 | :eval (< 1 2 3)) | ||
| 858 | (<= | ||
| 859 | :args (number &rest numbers) | ||
| 860 | :eval (<= 4 4) | ||
| 861 | :eval (<= 1 2 2 3)) | ||
| 862 | (> | ||
| 863 | :args (number &rest numbers) | ||
| 864 | :eval (> 4 4) | ||
| 865 | :eval (> 3 2 1)) | ||
| 866 | (>= | ||
| 867 | :args (number &rest numbers) | ||
| 868 | :eval (>= 4 4) | ||
| 869 | :eval (>= 3 2 2 1)) | ||
| 870 | "String" | ||
| 871 | (string-equal | ||
| 872 | :eval (string-equal "abc" "abc") | ||
| 873 | :eval (string-equal "abc" "ABC")) | ||
| 874 | (string-equal-ignore-case | ||
| 875 | :eval (string-equal-ignore-case "abc" "ABC")) | ||
| 876 | (string-lessp | ||
| 877 | :eval (string-lessp "abc" "abd") | ||
| 878 | :eval (string-lessp "abc" "abc") | ||
| 879 | :eval (string-lessp "pic4.png" "pic32.png")) | ||
| 880 | (string-greaterp | ||
| 881 | :eval (string-greaterp "abd" "abc") | ||
| 882 | :eval (string-greaterp "abc" "abc")) | ||
| 883 | (string-version-lessp | ||
| 884 | :eval (string-version-lessp "pic4.png" "pic32.png") | ||
| 885 | :eval (string-version-lessp "1.9.3" "1.10.2")) | ||
| 886 | (string-collate-lessp | ||
| 887 | :eval (string-collate-lessp "abc" "abd"))) | ||
| 888 | |||
| 889 | (define-short-documentation-group vector | ||
| 890 | "Making Vectors" | ||
| 891 | (make-vector | ||
| 892 | :eval (make-vector 5 "foo")) | ||
| 893 | (vector | ||
| 894 | :eval (vector 1 "b" 3)) | ||
| 895 | "Operations on Vectors" | ||
| 896 | (vectorp | ||
| 897 | :eval (vectorp [1]) | ||
| 898 | :eval (vectorp "1")) | ||
| 899 | (vconcat | ||
| 900 | :eval (vconcat '(1 2) [3 4])) | ||
| 901 | (append | ||
| 902 | :eval (append [1 2] nil)) | ||
| 903 | (length | ||
| 904 | :eval (length [1 2 3])) | ||
| 905 | (seq-reduce | ||
| 906 | :eval (seq-reduce #'+ [1 2 3] 0)) | ||
| 907 | (seq-subseq | ||
| 908 | :eval (seq-subseq [1 2 3 4 5] 1 3) | ||
| 909 | :eval (seq-subseq [1 2 3 4 5] 1)) | ||
| 910 | (copy-tree | ||
| 911 | :eval (copy-tree [1 (2 3) [4 5]] t)) | ||
| 912 | "Mapping Over Vectors" | ||
| 913 | (mapcar | ||
| 914 | :eval (mapcar #'identity [1 2 3])) | ||
| 915 | (mapc | ||
| 916 | :eval (mapc #'insert ["1" "2" "3"]))) | ||
| 917 | |||
| 918 | (define-short-documentation-group regexp | ||
| 919 | "Matching Strings" | ||
| 920 | (replace-regexp-in-string | ||
| 921 | :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) | ||
| 922 | (string-match-p | ||
| 923 | :eval (string-match-p "^[fo]+" "foobar")) | ||
| 924 | "Looking in Buffers" | ||
| 925 | (re-search-forward | ||
| 926 | :no-eval (re-search-forward "^foo$" nil t) | ||
| 927 | :eg-result 43) | ||
| 928 | (re-search-backward | ||
| 929 | :no-eval (re-search-backward "^foo$" nil t) | ||
| 930 | :eg-result 43) | ||
| 931 | (looking-at-p | ||
| 932 | :no-eval (looking-at-p "f[0-9]") | ||
| 933 | :eg-result t) | ||
| 934 | "Match Data" | ||
| 935 | (match-string | ||
| 936 | :eval (and (string-match "^\\([fo]+\\)b" "foobar") | ||
| 937 | (match-string 0 "foobar"))) | ||
| 938 | (match-beginning | ||
| 939 | :no-eval (match-beginning 1) | ||
| 940 | :eg-result 0) | ||
| 941 | (match-end | ||
| 942 | :no-eval (match-end 1) | ||
| 943 | :eg-result 3) | ||
| 944 | (save-match-data | ||
| 945 | :no-eval (save-match-data ...)) | ||
| 946 | "Replacing Match" | ||
| 947 | (replace-match | ||
| 948 | :no-eval (replace-match "new") | ||
| 949 | :eg-result nil) | ||
| 950 | (match-substitute-replacement | ||
| 951 | :no-eval (match-substitute-replacement "new") | ||
| 952 | :eg-result "new") | ||
| 953 | (replace-regexp-in-region | ||
| 954 | :no-value (replace-regexp-in-region "[0-9]+" "Num \\&")) | ||
| 955 | "Utilities" | ||
| 956 | (regexp-quote | ||
| 957 | :eval (regexp-quote "foo.*bar")) | ||
| 958 | (regexp-opt | ||
| 959 | :eval (regexp-opt '("foo" "bar"))) | ||
| 960 | (regexp-opt-depth | ||
| 961 | :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) | ||
| 962 | (regexp-opt-charset | ||
| 963 | :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) | ||
| 964 | "The `rx' Structured Regexp Notation" | ||
| 965 | (rx | ||
| 966 | :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) | ||
| 967 | (rx-to-string | ||
| 968 | :eval (rx-to-string '(| "foo" "bar"))) | ||
| 969 | (rx-define | ||
| 970 | :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) | ||
| 971 | (rx haskell-comment))" | ||
| 972 | :result "--.*") | ||
| 973 | (rx-let | ||
| 974 | :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) | ||
| 975 | (number (1+ digit)) | ||
| 976 | (numbers (comma-separated number))) | ||
| 977 | (rx \"(\" numbers \")\"))" | ||
| 978 | :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") | ||
| 979 | (rx-let-eval | ||
| 980 | :eval "(rx-let-eval | ||
| 981 | '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) | ||
| 982 | (rx-to-string | ||
| 983 | '(ponder (or \"flowers\" \"cars\" \"socks\"))))" | ||
| 984 | :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) | ||
| 985 | |||
| 986 | (define-short-documentation-group sequence | ||
| 987 | "Sequence Predicates" | ||
| 988 | (seq-contains-p | ||
| 989 | :eval (seq-contains-p '(a b c) 'b) | ||
| 990 | :eval (seq-contains-p '(a b c) 'd)) | ||
| 991 | (seq-every-p | ||
| 992 | :eval (seq-every-p #'numberp '(1 2 3))) | ||
| 993 | (seq-empty-p | ||
| 994 | :eval (seq-empty-p [])) | ||
| 995 | (seq-set-equal-p | ||
| 996 | :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) | ||
| 997 | (seq-some | ||
| 998 | :eval (seq-some #'floatp '(1 2.0 3))) | ||
| 999 | "Building Sequences" | ||
| 1000 | (seq-concatenate | ||
| 1001 | :eval (seq-concatenate 'vector '(1 2) '(c d))) | ||
| 1002 | (seq-copy | ||
| 1003 | :eval (seq-copy '(a 2))) | ||
| 1004 | (seq-into | ||
| 1005 | :eval (seq-into '(1 2 3) 'vector)) | ||
| 1006 | "Utility Functions" | ||
| 1007 | (seq-count | ||
| 1008 | :eval (seq-count #'numberp '(1 b c 4))) | ||
| 1009 | (seq-elt | ||
| 1010 | :eval (seq-elt '(a b c) 1)) | ||
| 1011 | (seq-random-elt | ||
| 1012 | :no-eval (seq-random-elt '(a b c)) | ||
| 1013 | :eg-result c) | ||
| 1014 | (seq-find | ||
| 1015 | :eval (seq-find #'numberp '(a b 3 4 f 6))) | ||
| 1016 | (seq-position | ||
| 1017 | :eval (seq-position '(a b c) 'c)) | ||
| 1018 | (seq-positions | ||
| 1019 | :eval (seq-positions '(a b c a d) 'a) | ||
| 1020 | :eval (seq-positions '(a b c a d) 'z) | ||
| 1021 | :eval (seq-positions '(11 5 7 12 9 15) 10 #'>=)) | ||
| 1022 | (seq-length | ||
| 1023 | :eval (seq-length "abcde")) | ||
| 1024 | (seq-max | ||
| 1025 | :eval (seq-max [1 2 3])) | ||
| 1026 | (seq-min | ||
| 1027 | :eval (seq-min [1 2 3])) | ||
| 1028 | (seq-first | ||
| 1029 | :eval (seq-first [a b c])) | ||
| 1030 | (seq-rest | ||
| 1031 | :eval (seq-rest '[1 2 3])) | ||
| 1032 | (seq-reverse | ||
| 1033 | :eval (seq-reverse '(1 2 3))) | ||
| 1034 | (seq-sort | ||
| 1035 | :eval (seq-sort #'> '(1 2 3))) | ||
| 1036 | (seq-sort-by | ||
| 1037 | :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) | ||
| 1038 | "Mapping Over Sequences" | ||
| 1039 | (seq-map | ||
| 1040 | :eval (seq-map #'1+ '(1 2 3))) | ||
| 1041 | (seq-map-indexed | ||
| 1042 | :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) | ||
| 1043 | (seq-mapcat | ||
| 1044 | :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) | ||
| 1045 | (seq-doseq | ||
| 1046 | :no-eval (seq-doseq (a '("foo" "bar")) (insert a)) | ||
| 1047 | :eg-result ("foo" "bar")) | ||
| 1048 | (seq-do | ||
| 1049 | :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) | ||
| 1050 | :eg-result ("foo" "bar")) | ||
| 1051 | (seq-do-indexed | ||
| 1052 | :no-eval (seq-do-indexed | ||
| 1053 | (lambda (a index) (message "%s:%s" index a)) | ||
| 1054 | '("foo" "bar")) | ||
| 1055 | :eg-result nil) | ||
| 1056 | (seq-reduce | ||
| 1057 | :eval (seq-reduce #'* [1 2 3] 2)) | ||
| 1058 | "Excerpting Sequences" | ||
| 1059 | (seq-drop | ||
| 1060 | :eval (seq-drop '(a b c) 2)) | ||
| 1061 | (seq-drop-while | ||
| 1062 | :eval (seq-drop-while #'numberp '(1 2 c d 5))) | ||
| 1063 | (seq-filter | ||
| 1064 | :eval (seq-filter #'numberp '(a b 3 4 f 6))) | ||
| 1065 | (seq-keep | ||
| 1066 | :eval (seq-keep #'car-safe '((1 2) 3 t (a . b)))) | ||
| 1067 | (seq-remove | ||
| 1068 | :eval (seq-remove #'numberp '(1 2 c d 5))) | ||
| 1069 | (seq-remove-at-position | ||
| 1070 | :eval (seq-remove-at-position '(a b c d e) 3) | ||
| 1071 | :eval (seq-remove-at-position [a b c d e] 0)) | ||
| 1072 | (seq-group-by | ||
| 1073 | :eval (seq-group-by #'natnump '(-1 2 3 -4 -5 6))) | ||
| 1074 | (seq-union | ||
| 1075 | :eval (seq-union '(1 2 3) '(3 5))) | ||
| 1076 | (seq-difference | ||
| 1077 | :eval (seq-difference '(1 2 3) '(2 3 4))) | ||
| 1078 | (seq-intersection | ||
| 1079 | :eval (seq-intersection '(1 2 3) '(2 3 4))) | ||
| 1080 | (seq-partition | ||
| 1081 | :eval (seq-partition '(a b c d e f g h) 3)) | ||
| 1082 | (seq-subseq | ||
| 1083 | :eval (seq-subseq '(a b c d e) 2 4)) | ||
| 1084 | (seq-take | ||
| 1085 | :eval (seq-take '(a b c d e) 3)) | ||
| 1086 | (seq-split | ||
| 1087 | :eval (seq-split [0 1 2 3 5] 2)) | ||
| 1088 | (seq-take-while | ||
| 1089 | :eval (seq-take-while #'integerp [1 2 3.0 4])) | ||
| 1090 | (seq-uniq | ||
| 1091 | :eval (seq-uniq '(a b d b a c)))) | ||
| 1092 | |||
| 1093 | (define-short-documentation-group buffer | ||
| 1094 | "Buffer Basics" | ||
| 1095 | (current-buffer | ||
| 1096 | :no-eval (current-buffer) | ||
| 1097 | :eg-result-string "#<buffer shortdoc.el>") | ||
| 1098 | (bufferp | ||
| 1099 | :eval (bufferp 23)) | ||
| 1100 | (buffer-live-p | ||
| 1101 | :no-eval (buffer-live-p some-buffer) | ||
| 1102 | :eg-result t) | ||
| 1103 | (buffer-modified-p | ||
| 1104 | :eval (buffer-modified-p (current-buffer))) | ||
| 1105 | (buffer-name | ||
| 1106 | :eval (buffer-name)) | ||
| 1107 | (window-buffer | ||
| 1108 | :eval (window-buffer)) | ||
| 1109 | "Selecting Buffers" | ||
| 1110 | (get-buffer-create | ||
| 1111 | :no-eval (get-buffer-create "*foo*") | ||
| 1112 | :eg-result-string "#<buffer *foo*>") | ||
| 1113 | (pop-to-buffer | ||
| 1114 | :no-eval (pop-to-buffer "*foo*") | ||
| 1115 | :eg-result-string "#<buffer *foo*>") | ||
| 1116 | (with-current-buffer | ||
| 1117 | :no-eval* (with-current-buffer buffer (buffer-size))) | ||
| 1118 | "Points and Positions" | ||
| 1119 | (point | ||
| 1120 | :eval (point)) | ||
| 1121 | (point-min | ||
| 1122 | :eval (point-min)) | ||
| 1123 | (point-max | ||
| 1124 | :eval (point-max)) | ||
| 1125 | (pos-bol | ||
| 1126 | :eval (pos-bol)) | ||
| 1127 | (pos-eol | ||
| 1128 | :eval (pos-eol)) | ||
| 1129 | (bolp | ||
| 1130 | :eval (bolp)) | ||
| 1131 | (eolp | ||
| 1132 | :eval (eolp)) | ||
| 1133 | (line-beginning-position | ||
| 1134 | :eval (line-beginning-position)) | ||
| 1135 | (line-end-position | ||
| 1136 | :eval (line-end-position)) | ||
| 1137 | (buffer-size | ||
| 1138 | :eval (buffer-size)) | ||
| 1139 | (bobp | ||
| 1140 | :eval (bobp)) | ||
| 1141 | (eobp | ||
| 1142 | :eval (eobp)) | ||
| 1143 | "Moving Around" | ||
| 1144 | (goto-char | ||
| 1145 | :no-eval (goto-char (point-max)) | ||
| 1146 | :eg-result 342) | ||
| 1147 | (search-forward | ||
| 1148 | :no-eval (search-forward "some-string" nil t) | ||
| 1149 | :eg-result 245) | ||
| 1150 | (re-search-forward | ||
| 1151 | :no-eval (re-search-forward "some-s.*g" nil t) | ||
| 1152 | :eg-result 245) | ||
| 1153 | (forward-line | ||
| 1154 | :no-eval (forward-line 1) | ||
| 1155 | :eg-result 0 | ||
| 1156 | :no-eval (forward-line -2) | ||
| 1157 | :eg-result 0) | ||
| 1158 | "Strings from Buffers" | ||
| 1159 | (buffer-string | ||
| 1160 | :no-eval* (buffer-string)) | ||
| 1161 | (buffer-substring | ||
| 1162 | :eval (buffer-substring (point-min) (+ (point-min) 10))) | ||
| 1163 | (buffer-substring-no-properties | ||
| 1164 | :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) | ||
| 1165 | (following-char | ||
| 1166 | :no-eval (following-char) | ||
| 1167 | :eg-result 67) | ||
| 1168 | (preceding-char | ||
| 1169 | :no-eval (preceding-char) | ||
| 1170 | :eg-result 38) | ||
| 1171 | (char-after | ||
| 1172 | :eval (char-after 45)) | ||
| 1173 | (char-before | ||
| 1174 | :eval (char-before 13)) | ||
| 1175 | (get-byte | ||
| 1176 | :no-eval (get-byte 45) | ||
| 1177 | :eg-result-string "#xff") | ||
| 1178 | "Altering Buffers" | ||
| 1179 | (delete-region | ||
| 1180 | :no-value (delete-region (point-min) (point-max))) | ||
| 1181 | (erase-buffer | ||
| 1182 | :no-value (erase-buffer)) | ||
| 1183 | (delete-line | ||
| 1184 | :no-value (delete-line)) | ||
| 1185 | (insert | ||
| 1186 | :no-value (insert "This string will be inserted in the buffer\n")) | ||
| 1187 | (subst-char-in-region | ||
| 1188 | :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)") | ||
| 1189 | (replace-string-in-region | ||
| 1190 | :no-value (replace-string-in-region "foo" "bar")) | ||
| 1191 | "Locking" | ||
| 1192 | (lock-buffer | ||
| 1193 | :no-value (lock-buffer "/tmp/foo")) | ||
| 1194 | (unlock-buffer | ||
| 1195 | :no-value (unlock-buffer))) | ||
| 1196 | |||
| 1197 | (define-short-documentation-group overlay | ||
| 1198 | "Predicates" | ||
| 1199 | (overlayp | ||
| 1200 | :no-eval (overlayp some-overlay) | ||
| 1201 | :eg-result t) | ||
| 1202 | "Creation and Deletion" | ||
| 1203 | (make-overlay | ||
| 1204 | :args (beg end &optional buffer) | ||
| 1205 | :no-eval (make-overlay 1 10) | ||
| 1206 | :eg-result-string "#<overlay from 1 to 10 in *foo*>") | ||
| 1207 | (delete-overlay | ||
| 1208 | :no-eval (delete-overlay foo) | ||
| 1209 | :eg-result t) | ||
| 1210 | "Searching Overlays" | ||
| 1211 | (overlays-at | ||
| 1212 | :no-eval (overlays-at 15) | ||
| 1213 | :eg-result-string "(#<overlay from 1 to 10 in *foo*>)") | ||
| 1214 | (overlays-in | ||
| 1215 | :no-eval (overlays-in 1 30) | ||
| 1216 | :eg-result-string "(#<overlay from 1 to 10 in *foo*>)") | ||
| 1217 | (next-overlay-change | ||
| 1218 | :no-eval (next-overlay-change 1) | ||
| 1219 | :eg-result 20) | ||
| 1220 | (previous-overlay-change | ||
| 1221 | :no-eval (previous-overlay-change 30) | ||
| 1222 | :eg-result 20) | ||
| 1223 | "Overlay Properties" | ||
| 1224 | (overlay-start | ||
| 1225 | :no-eval (overlay-start foo) | ||
| 1226 | :eg-result 1) | ||
| 1227 | (overlay-end | ||
| 1228 | :no-eval (overlay-end foo) | ||
| 1229 | :eg-result 10) | ||
| 1230 | (overlay-put | ||
| 1231 | :no-eval (overlay-put foo 'happy t) | ||
| 1232 | :eg-result t) | ||
| 1233 | (overlay-get | ||
| 1234 | :no-eval (overlay-get foo 'happy) | ||
| 1235 | :eg-result t) | ||
| 1236 | (overlay-buffer | ||
| 1237 | :no-eval (overlay-buffer foo)) | ||
| 1238 | "Moving Overlays" | ||
| 1239 | (move-overlay | ||
| 1240 | :no-eval (move-overlay foo 5 20) | ||
| 1241 | :eg-result-string "#<overlay from 5 to 20 in *foo*>")) | ||
| 1242 | |||
| 1243 | (define-short-documentation-group process | ||
| 1244 | (make-process | ||
| 1245 | :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) | ||
| 1246 | :eg-result-string "#<process foo>") | ||
| 1247 | (processp | ||
| 1248 | :eval (processp t)) | ||
| 1249 | (process-status | ||
| 1250 | :no-eval (process-status process) | ||
| 1251 | :eg-result exit) | ||
| 1252 | (delete-process | ||
| 1253 | :no-value (delete-process process)) | ||
| 1254 | (kill-process | ||
| 1255 | :no-value (kill-process process)) | ||
| 1256 | (set-process-sentinel | ||
| 1257 | :no-value (set-process-sentinel process (lambda (proc string)))) | ||
| 1258 | (process-buffer | ||
| 1259 | :no-eval (process-buffer process) | ||
| 1260 | :eg-result-string "#<buffer *foo*>") | ||
| 1261 | (get-buffer-process | ||
| 1262 | :no-eval (get-buffer-process buffer) | ||
| 1263 | :eg-result-string "#<process foo>") | ||
| 1264 | (process-live-p | ||
| 1265 | :no-eval (process-live-p process) | ||
| 1266 | :eg-result t)) | ||
| 1267 | |||
| 1268 | (define-short-documentation-group number | ||
| 1269 | "Arithmetic" | ||
| 1270 | (+ | ||
| 1271 | :args (&rest numbers) | ||
| 1272 | :eval (+ 1 2) | ||
| 1273 | :eval (+ 1 2 3 4)) | ||
| 1274 | (- | ||
| 1275 | :args (&rest numbers) | ||
| 1276 | :eval (- 3 2) | ||
| 1277 | :eval (- 6 3 2)) | ||
| 1278 | (* | ||
| 1279 | :args (&rest numbers) | ||
| 1280 | :eval (* 3 4 5)) | ||
| 1281 | (/ | ||
| 1282 | :eval (/ 10 5) | ||
| 1283 | :eval (/ 10 6) | ||
| 1284 | :eval (/ 10.0 6) | ||
| 1285 | :eval (/ 10.0 3 3)) | ||
| 1286 | (% | ||
| 1287 | :eval (% 10 5) | ||
| 1288 | :eval (% 10 6)) | ||
| 1289 | (mod | ||
| 1290 | :eval (mod 10 5) | ||
| 1291 | :eval (mod 10 6) | ||
| 1292 | :eval (mod 10.5 6)) | ||
| 1293 | (1+ | ||
| 1294 | :eval (1+ 2) | ||
| 1295 | :eval (let ((x 2)) (1+ x) x)) | ||
| 1296 | (1- | ||
| 1297 | :eval (1- 4) | ||
| 1298 | :eval (let ((x 4)) (1- x) x)) | ||
| 1299 | (incf | ||
| 1300 | :eval (let ((x 2)) (incf x) x) | ||
| 1301 | :eval (let ((x 2)) (incf x 2) x)) | ||
| 1302 | (decf | ||
| 1303 | :eval (let ((x 4)) (decf x) x) | ||
| 1304 | :eval (let ((x 4)) (decf x 2) x)) | ||
| 1305 | "Predicates" | ||
| 1306 | (= | ||
| 1307 | :args (number &rest numbers) | ||
| 1308 | :eval (= 4 4) | ||
| 1309 | :eval (= 4.0 4.0) | ||
| 1310 | :eval (= 4 4.0) | ||
| 1311 | :eval (= 4 4 4 4)) | ||
| 1312 | (eql | ||
| 1313 | :eval (eql 4 4) | ||
| 1314 | :eval (eql 4.0 4.0)) | ||
| 1315 | (/= | ||
| 1316 | :eval (/= 4 4)) | ||
| 1317 | (< | ||
| 1318 | :args (number &rest numbers) | ||
| 1319 | :eval (< 4 4) | ||
| 1320 | :eval (< 1 2 3)) | ||
| 1321 | (<= | ||
| 1322 | :args (number &rest numbers) | ||
| 1323 | :eval (<= 4 4) | ||
| 1324 | :eval (<= 1 2 2 3)) | ||
| 1325 | (> | ||
| 1326 | :args (number &rest numbers) | ||
| 1327 | :eval (> 4 4) | ||
| 1328 | :eval (> 3 2 1)) | ||
| 1329 | (>= | ||
| 1330 | :args (number &rest numbers) | ||
| 1331 | :eval (>= 4 4) | ||
| 1332 | :eval (>= 3 2 2 1)) | ||
| 1333 | (zerop | ||
| 1334 | :eval (zerop 0)) | ||
| 1335 | (natnump | ||
| 1336 | :eval (natnump -1) | ||
| 1337 | :eval (natnump 0) | ||
| 1338 | :eval (natnump 23)) | ||
| 1339 | (plusp | ||
| 1340 | :eval (plusp 0) | ||
| 1341 | :eval (plusp 1)) | ||
| 1342 | (minusp | ||
| 1343 | :eval (minusp 0) | ||
| 1344 | :eval (minusp -1)) | ||
| 1345 | (oddp | ||
| 1346 | :eval (oddp 3)) | ||
| 1347 | (evenp | ||
| 1348 | :eval (evenp 6)) | ||
| 1349 | (bignump | ||
| 1350 | :eval (bignump 4) | ||
| 1351 | :eval (bignump (expt 2 90))) | ||
| 1352 | (fixnump | ||
| 1353 | :eval (fixnump 4) | ||
| 1354 | :eval (fixnump (expt 2 90))) | ||
| 1355 | (floatp | ||
| 1356 | :eval (floatp 5.4)) | ||
| 1357 | (integerp | ||
| 1358 | :eval (integerp 5.4)) | ||
| 1359 | (numberp | ||
| 1360 | :eval (numberp "5.4")) | ||
| 1361 | (cl-digit-char-p | ||
| 1362 | :eval (cl-digit-char-p ?5 10) | ||
| 1363 | :eval (cl-digit-char-p ?f 16)) | ||
| 1364 | "Operations" | ||
| 1365 | (max | ||
| 1366 | :args (number &rest numbers) | ||
| 1367 | :eval (max 7 9 3)) | ||
| 1368 | (min | ||
| 1369 | :args (number &rest numbers) | ||
| 1370 | :eval (min 7 9 3)) | ||
| 1371 | (abs | ||
| 1372 | :eval (abs -4)) | ||
| 1373 | (float | ||
| 1374 | :eval (float 2)) | ||
| 1375 | (truncate | ||
| 1376 | :eval (truncate 1.2) | ||
| 1377 | :eval (truncate -1.2) | ||
| 1378 | :eval (truncate 5.4 2)) | ||
| 1379 | (floor | ||
| 1380 | :eval (floor 1.2) | ||
| 1381 | :eval (floor -1.2) | ||
| 1382 | :eval (floor 5.4 2)) | ||
| 1383 | (ceiling | ||
| 1384 | :eval (ceiling 1.2) | ||
| 1385 | :eval (ceiling -1.2) | ||
| 1386 | :eval (ceiling 5.4 2)) | ||
| 1387 | (round | ||
| 1388 | :eval (round 1.2) | ||
| 1389 | :eval (round -1.2) | ||
| 1390 | :eval (round 5.4 2)) | ||
| 1391 | (random | ||
| 1392 | :eval (random 6)) | ||
| 1393 | "Bit Operations" | ||
| 1394 | (ash | ||
| 1395 | :eval (ash 1 4) | ||
| 1396 | :eval (ash 16 -1)) | ||
| 1397 | (logand | ||
| 1398 | :no-eval "(logand #b10 #b111)" | ||
| 1399 | :result-string "#b10") | ||
| 1400 | (logior | ||
| 1401 | :eval (logior 4 16)) | ||
| 1402 | (logxor | ||
| 1403 | :eval (logxor 4 16)) | ||
| 1404 | (lognot | ||
| 1405 | :eval (lognot 5)) | ||
| 1406 | (logcount | ||
| 1407 | :eval (logcount 5)) | ||
| 1408 | "Floating Point" | ||
| 1409 | (isnan | ||
| 1410 | :eval (isnan 5.0)) | ||
| 1411 | (frexp | ||
| 1412 | :eval (frexp 5.7)) | ||
| 1413 | (ldexp | ||
| 1414 | :eval (ldexp 0.7125 3)) | ||
| 1415 | (logb | ||
| 1416 | :eval (logb 10.5)) | ||
| 1417 | (ffloor | ||
| 1418 | :eval (ffloor 1.2)) | ||
| 1419 | (fceiling | ||
| 1420 | :eval (fceiling 1.2)) | ||
| 1421 | (ftruncate | ||
| 1422 | :eval (ftruncate 1.2)) | ||
| 1423 | (fround | ||
| 1424 | :eval (fround 1.2)) | ||
| 1425 | "Standard Math Functions" | ||
| 1426 | (sin | ||
| 1427 | :eval (sin float-pi)) | ||
| 1428 | (cos | ||
| 1429 | :eval (cos float-pi)) | ||
| 1430 | (tan | ||
| 1431 | :eval (tan float-pi)) | ||
| 1432 | (asin | ||
| 1433 | :eval (asin float-pi)) | ||
| 1434 | (acos | ||
| 1435 | :eval (acos float-pi)) | ||
| 1436 | (atan | ||
| 1437 | :eval (atan float-pi)) | ||
| 1438 | (exp | ||
| 1439 | :eval (exp 4)) | ||
| 1440 | (log | ||
| 1441 | :eval (log 54.59)) | ||
| 1442 | (expt | ||
| 1443 | :eval (expt 2 16)) | ||
| 1444 | (sqrt | ||
| 1445 | :eval (sqrt -1))) | ||
| 1446 | |||
| 1447 | (define-short-documentation-group text-properties | ||
| 1448 | "Examining Text Properties" | ||
| 1449 | (get-text-property | ||
| 1450 | :eval (get-text-property 0 'foo (propertize "x" 'foo t))) | ||
| 1451 | (get-char-property | ||
| 1452 | :eval (get-char-property 0 'foo (propertize "x" 'foo t))) | ||
| 1453 | (get-pos-property | ||
| 1454 | :eval (get-pos-property 0 'foo (propertize "x" 'foo t))) | ||
| 1455 | (get-char-property-and-overlay | ||
| 1456 | :eval (get-char-property-and-overlay 0 'foo (propertize "x" 'foo t))) | ||
| 1457 | (text-properties-at | ||
| 1458 | :eval (text-properties-at (point))) | ||
| 1459 | "Changing Text Properties" | ||
| 1460 | (put-text-property | ||
| 1461 | :eval (let ((s (copy-sequence "abc"))) (put-text-property 0 1 'foo t s) s) | ||
| 1462 | :no-eval (put-text-property (point) (1+ (point)) 'face 'error)) | ||
| 1463 | (add-text-properties | ||
| 1464 | :no-eval (add-text-properties (point) (1+ (point)) '(face error))) | ||
| 1465 | (remove-text-properties | ||
| 1466 | :no-eval (remove-text-properties (point) (1+ (point)) '(face nil))) | ||
| 1467 | (remove-list-of-text-properties | ||
| 1468 | :no-eval (remove-list-of-text-properties (point) (1+ (point)) '(face font-lock-face))) | ||
| 1469 | (set-text-properties | ||
| 1470 | :no-eval (set-text-properties (point) (1+ (point)) '(face error))) | ||
| 1471 | (add-face-text-property | ||
| 1472 | :no-eval (add-face-text-property START END '(:foreground "green"))) | ||
| 1473 | (propertize | ||
| 1474 | :eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic)) | ||
| 1475 | "Searching for Text Properties" | ||
| 1476 | (next-property-change | ||
| 1477 | :no-eval (next-property-change (point) (current-buffer))) | ||
| 1478 | (previous-property-change | ||
| 1479 | :no-eval (previous-property-change (point) (current-buffer))) | ||
| 1480 | (next-single-property-change | ||
| 1481 | :no-eval (next-single-property-change (point) 'face (current-buffer))) | ||
| 1482 | (previous-single-property-change | ||
| 1483 | :no-eval (previous-single-property-change (point) 'face (current-buffer))) | ||
| 1484 | ;; TODO: There are some more that could be added here. | ||
| 1485 | (text-property-search-forward | ||
| 1486 | :no-eval (text-property-search-forward 'face nil t)) | ||
| 1487 | (text-property-search-backward | ||
| 1488 | :no-eval (text-property-search-backward 'face nil t))) | ||
| 1489 | |||
| 1490 | (define-short-documentation-group keymaps | ||
| 1491 | "Defining keymaps or adding bindings to existing keymaps" | ||
| 1492 | (define-keymap | ||
| 1493 | :no-eval (define-keymap "C-c C-c" #'quit-buffer) | ||
| 1494 | :no-eval (define-keymap :keymap ctl-x-map | ||
| 1495 | "C-r" #'recentf-open | ||
| 1496 | "k" #'kill-current-buffer)) | ||
| 1497 | (defvar-keymap | ||
| 1498 | :no-eval (defvar-keymap my-keymap "C-c C-c" #'quit-buffer)) | ||
| 1499 | "Setting keys" | ||
| 1500 | (keymap-set | ||
| 1501 | :no-eval (keymap-set map "C-c C-c" #'quit-buffer)) | ||
| 1502 | (keymap-local-set | ||
| 1503 | :no-eval (keymap-local-set "C-c C-c" #'quit-buffer)) | ||
| 1504 | (keymap-global-set | ||
| 1505 | :no-eval (keymap-global-set "C-c C-c" #'quit-buffer)) | ||
| 1506 | (keymap-unset | ||
| 1507 | :no-eval (keymap-unset map "C-c C-c")) | ||
| 1508 | (keymap-local-unset | ||
| 1509 | :no-eval (keymap-local-unset "C-c C-c")) | ||
| 1510 | (keymap-global-unset | ||
| 1511 | :no-eval (keymap-global-unset "C-c C-c")) | ||
| 1512 | (keymap-substitute | ||
| 1513 | :no-eval (keymap-substitute map "C-c C-c" "M-a")) | ||
| 1514 | (keymap-set-after | ||
| 1515 | :no-eval (keymap-set-after map "<separator-2>" menu-bar-separator)) | ||
| 1516 | "Predicates" | ||
| 1517 | (keymapp | ||
| 1518 | :eval (keymapp (define-keymap))) | ||
| 1519 | (key-valid-p | ||
| 1520 | :eval (key-valid-p "C-c C-c") | ||
| 1521 | :eval (key-valid-p "C-cC-c")) | ||
| 1522 | "Lookup" | ||
| 1523 | (keymap-lookup | ||
| 1524 | :eval (keymap-lookup (current-global-map) "C-x x g"))) | ||
| 1525 | |||
| 1526 | (provide 'shortdoc-doc) | ||
| 1527 | |||
| 1528 | ;;; shortdoc-doc.el ends here | ||
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index ea6910c60fc..e8ba6ededc0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el | |||
| @@ -25,8 +25,8 @@ | |||
| 25 | ;; This package lists functions based on various groupings. | 25 | ;; This package lists functions based on various groupings. |
| 26 | ;; | 26 | ;; |
| 27 | ;; For instance, `string-trim' and `mapconcat' are `string' functions, | 27 | ;; For instance, `string-trim' and `mapconcat' are `string' functions, |
| 28 | ;; so `M-x shortdoc RET string RET' will give an overview of functions | 28 | ;; so `M-x shortdoc RET string RET' will give an overview of these and |
| 29 | ;; that operate on strings. | 29 | ;; other functions that operate on strings. |
| 30 | ;; | 30 | ;; |
| 31 | ;; The documentation groups are created with the | 31 | ;; The documentation groups are created with the |
| 32 | ;; `define-short-documentation-group' macro. | 32 | ;; `define-short-documentation-group' macro. |
| @@ -50,23 +50,109 @@ | |||
| 50 | '((t :inherit variable-pitch)) | 50 | '((t :inherit variable-pitch)) |
| 51 | "Face used for a section.") | 51 | "Face used for a section.") |
| 52 | 52 | ||
| 53 | ;;;###autoload | 53 | |
| 54 | (defun shortdoc--check (group functions) | 54 | ;; Almost all past Emacs versions (but see note on Emacs 30 below) |
| 55 | (let ((keywords '( :no-manual :args :eval :no-eval :no-value :no-eval* | 55 | ;; understand the following shortdoc group structure: |
| 56 | :result :result-string :eg-result :eg-result-string :doc))) | 56 | ;; |
| 57 | (dolist (f functions) | 57 | ;; (SYMBOL ;; shortdoc group name |
| 58 | (when (consp f) | 58 | ;; (:group [:KEYWORD VALUE ...]) ;; group properties |
| 59 | (dolist (x f) | 59 | ;; STRING ;; shortdoc section title |
| 60 | (when (and (keywordp x) (not (memq x keywords))) | 60 | ;; (:section [:KEYWORD VALUE ...]) ;; section properties |
| 61 | (error "Shortdoc %s function `%s': bad keyword `%s'" | 61 | ;; |
| 62 | group (car f) x))))))) | 62 | ;; (SYMBOL ;; shortdoc item |
| 63 | ;; [:KEYWORD VALUE ...]) ;; item properties | ||
| 64 | ;; ([:item] FORM ;; generalized shortdoc item | ||
| 65 | ;; [:KEYWORD VALUE ...])) ;; item properties | ||
| 66 | ;; | ||
| 67 | ;; Where: | ||
| 68 | ;; - a group definition must contain at least one section title or item; | ||
| 69 | ;; - group and section properties must occur at most once after the | ||
| 70 | ;; group name and a section title, respectively; | ||
| 71 | ;; - the leading `:item' keyword of a generalized shortdoc item may be | ||
| 72 | ;; omitted if the shortdoc group is not intended to be used on Emacs | ||
| 73 | ;; versions older than Emacs 32; | ||
| 74 | ;; - the group, secion, or item properties may be empty. | ||
| 75 | ;; | ||
| 76 | ;; That does not mean that any such shortdoc group is meaningful. And | ||
| 77 | ;; that does not mean that past Emacs version actually use all the bits | ||
| 78 | ;; available in such a definition. But they will not error out when | ||
| 79 | ;; processing a definition with the format layed out above, they will | ||
| 80 | ;; simply silently ignore those bits unknown to them (specifically | ||
| 81 | ;; unknown keywords) and attempt to make the best out of the rest. | ||
| 82 | ;; | ||
| 83 | ;; Why is this important? Because it gives package authors a guarantee | ||
| 84 | ;; that they can use shortdoc features of newer Emacs versions without | ||
| 85 | ;; older Emacs versions breaking on them. | ||
| 86 | ;; | ||
| 87 | ;; So Emacs developers, please | ||
| 88 | ;; | ||
| 89 | ;; - stick to above structure when extending shortdoc.el (so that past | ||
| 90 | ;; Emacs versions can grok your extensions without breaking); and | ||
| 91 | ;; | ||
| 92 | ;; - do not impose any additional restrictions on the format described | ||
| 93 | ;; above and on the allowed keywords (so that you do not limit the | ||
| 94 | ;; options of future Emacs versions). | ||
| 95 | ;; | ||
| 96 | ;; Emacs 30, for example, had introduced some restrictions on item | ||
| 97 | ;; property keywords. As a result, we need that hack mentioned in the | ||
| 98 | ;; "boilerplate template for Emacs package authors" above. | ||
| 99 | |||
| 100 | (defun shortdoc--keyword-plist-p (object) | ||
| 101 | "Return non-nil if OBJECT is a plist with keywords as property names." | ||
| 102 | (let ((ok (proper-list-p object))) | ||
| 103 | (while (and ok object) | ||
| 104 | (setq ok (and (keywordp (car object)) (cdr object)) | ||
| 105 | object (cddr object))) | ||
| 106 | ok)) | ||
| 107 | |||
| 108 | (defun shortdoc--check (group definition) | ||
| 109 | "Ensure that (GROUP DEFINITION) is a valid shortdoc group definition. | ||
| 110 | Signal an error if that is not the case." | ||
| 111 | (unless (symbolp group) | ||
| 112 | (signal 'wrong-type-argument (list 'symbolp group))) | ||
| 113 | (unless (proper-list-p definition) | ||
| 114 | (signal 'wrong-type-argument (list 'proper-list-p definition))) | ||
| 115 | (let ((has-content nil) | ||
| 116 | entry keyword type | ||
| 117 | (prev-type 'group-name)) | ||
| 118 | (while definition | ||
| 119 | (setq entry (car definition) | ||
| 120 | keyword (car-safe entry) | ||
| 121 | type (cond | ||
| 122 | ((and (eq keyword :group) | ||
| 123 | (shortdoc--keyword-plist-p (cdr entry))) | ||
| 124 | 'group-properties) | ||
| 125 | ((stringp entry) 'section-title) | ||
| 126 | ((and (eq keyword :section) | ||
| 127 | (shortdoc--keyword-plist-p (cdr entry))) | ||
| 128 | 'section-properties) | ||
| 129 | ((and (eq keyword :item) | ||
| 130 | (shortdoc--keyword-plist-p entry)) | ||
| 131 | 'item-definition) | ||
| 132 | ((and (consp entry) | ||
| 133 | (shortdoc--keyword-plist-p (cdr entry))) | ||
| 134 | 'item-definition) | ||
| 135 | (t 'invalid))) | ||
| 136 | (cond ((memq type '(section-title item-definition)) | ||
| 137 | (setq has-content t)) | ||
| 138 | ((and (eq type 'group-properties) | ||
| 139 | (eq prev-type 'group-name))) | ||
| 140 | ((and (eq type 'section-properties) | ||
| 141 | (eq prev-type 'section-title))) | ||
| 142 | (t | ||
| 143 | (error "Shortdoc group %s with invalid entry %S" | ||
| 144 | group entry))) | ||
| 145 | (setq prev-type type | ||
| 146 | definition (cdr definition))) | ||
| 147 | (unless has-content | ||
| 148 | (error "Shortdoc group %s without content" group)))) | ||
| 63 | 149 | ||
| 64 | ;;;###autoload | 150 | ;;;###autoload |
| 65 | (progn | 151 | (defvar shortdoc--groups nil) |
| 66 | (defvar shortdoc--groups nil) | ||
| 67 | 152 | ||
| 68 | (defmacro define-short-documentation-group (group &rest functions) | 153 | ;;;###autoload |
| 69 | "Add GROUP to the list of defined documentation groups. | 154 | (defmacro define-short-documentation-group (group &rest functions) |
| 155 | "Add GROUP to the list of defined documentation groups. | ||
| 70 | FUNCTIONS is a list of elements on the form: | 156 | FUNCTIONS is a list of elements on the form: |
| 71 | 157 | ||
| 72 | (FUNC | 158 | (FUNC |
| @@ -128,1504 +214,28 @@ execution of the documented form depends on some conditions. | |||
| 128 | A FUNC form can have any number of `:no-eval' (or `:no-value'), | 214 | A FUNC form can have any number of `:no-eval' (or `:no-value'), |
| 129 | `:no-eval*', `:result', `:result-string', `:eg-result' and | 215 | `:no-eval*', `:result', `:result-string', `:eg-result' and |
| 130 | `:eg-result-string' properties." | 216 | `:eg-result-string' properties." |
| 131 | (declare (indent defun)) | 217 | (declare (indent defun)) |
| 132 | (shortdoc--check group functions) | 218 | (let ((err |
| 133 | `(progn | 219 | (condition-case err |
| 134 | (setq shortdoc--groups (delq (assq ',group shortdoc--groups) | 220 | (progn (shortdoc--check group functions) nil) |
| 135 | shortdoc--groups)) | 221 | (error err))) |
| 136 | (push (cons ',group ',functions) shortdoc--groups)))) | 222 | (exp |
| 137 | 223 | `(progn | |
| 138 | (define-short-documentation-group alist | 224 | (setq shortdoc--groups (delq (assq ',group shortdoc--groups) |
| 139 | "Alist Basics" | 225 | shortdoc--groups)) |
| 140 | (assoc | 226 | (push (cons ',group ',functions) shortdoc--groups)))) |
| 141 | :eval (assoc 'foo '((foo . bar) (zot . baz)))) | 227 | (if (null err) |
| 142 | (rassoc | 228 | exp |
| 143 | :eval (rassoc 'bar '((foo . bar) (zot . baz)))) | 229 | (macroexp-warn-and-return |
| 144 | (assq | 230 | (error-message-string err) exp nil t)))) |
| 145 | :eval (assq 'foo '((foo . bar) (zot . baz)))) | 231 | |
| 146 | (rassq | 232 | ;; FIXME: As long as we do not have a better mechanism to load shortdoc |
| 147 | :eval (rassq 'bar '((foo . bar) (zot . baz)))) | 233 | ;; definitions on demand, we must require `shortdoc-doc' after above |
| 148 | (assoc-string | 234 | ;; macro to avoid loading cycles. But at least we do not require |
| 149 | :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) | 235 | ;; `shortdoc-doc' while compiling this file, only when loading it. |
| 150 | "Manipulating Alists" | 236 | (if t (require 'shortdoc-doc)) |
| 151 | (assoc-delete-all | 237 | |
| 152 | :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) | 238 | |
| 153 | (assq-delete-all | ||
| 154 | :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) | ||
| 155 | (rassq-delete-all | ||
| 156 | :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) | ||
| 157 | (alist-get | ||
| 158 | :eval (let ((foo '((bar . baz)))) | ||
| 159 | (setf (alist-get 'bar foo) 'zot) | ||
| 160 | foo)) | ||
| 161 | "Misc" | ||
| 162 | (assoc-default | ||
| 163 | :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) | ||
| 164 | (copy-alist | ||
| 165 | :eval (let* ((old '((foo . bar))) | ||
| 166 | (new (copy-alist old))) | ||
| 167 | (eq old new))) | ||
| 168 | ;; FIXME: Outputs "\.rose" for the symbol `.rose'. It would be | ||
| 169 | ;; better if that could be cleaned up. | ||
| 170 | (let-alist | ||
| 171 | :eval (let ((colors '((rose . red) | ||
| 172 | (lily . white)))) | ||
| 173 | (let-alist colors | ||
| 174 | (if (eq .rose 'red) | ||
| 175 | .lily))))) | ||
| 176 | |||
| 177 | (define-short-documentation-group map | ||
| 178 | "Map Basics" | ||
| 179 | (mapp | ||
| 180 | :eval (mapp (list 'bar 1 'foo 2 'baz 3)) | ||
| 181 | :eval (mapp (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 182 | :eval (mapp [bar foo baz]) | ||
| 183 | :eval (mapp "this is a string") | ||
| 184 | :eval (mapp #s(hash-table data (bar 1 foo 2 baz 3))) | ||
| 185 | :eval (mapp '()) | ||
| 186 | :eval (mapp nil) | ||
| 187 | :eval (mapp (make-char-table 'shortdoc-test))) | ||
| 188 | (map-empty-p | ||
| 189 | :args (map) | ||
| 190 | :eval (map-empty-p nil) | ||
| 191 | :eval (map-empty-p []) | ||
| 192 | :eval (map-empty-p '())) | ||
| 193 | (map-elt | ||
| 194 | :args (map key) | ||
| 195 | :eval (map-elt (list 'bar 1 'foo 2 'baz 3) 'foo) | ||
| 196 | :eval (map-elt (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) | ||
| 197 | :eval (map-elt [bar foo baz] 1) | ||
| 198 | :eval (map-elt #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) | ||
| 199 | (map-contains-key | ||
| 200 | :args (map key) | ||
| 201 | :eval (map-contains-key (list 'bar 1 'foo 2 'baz 3) 'foo) | ||
| 202 | :eval (map-contains-key (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) | ||
| 203 | :eval (map-contains-key [bar foo baz] 1) | ||
| 204 | :eval (map-contains-key #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) | ||
| 205 | (map-put! | ||
| 206 | (map key value) | ||
| 207 | :eval | ||
| 208 | "(let ((map (list 'bar 1 'baz 3))) | ||
| 209 | (map-put! map 'foo 2) | ||
| 210 | map)" | ||
| 211 | ;; This signals map-not-inplace when used in shortdoc.el :-( | ||
| 212 | ;; :eval | ||
| 213 | ;; "(let ((map (list '(bar . 1) '(baz . 3)))) | ||
| 214 | ;; (map-put! map 'foo 2) | ||
| 215 | ;; map)" | ||
| 216 | :eval | ||
| 217 | "(let ((map [bar bot baz])) | ||
| 218 | (map-put! map 1 'foo) | ||
| 219 | map)" | ||
| 220 | :eval | ||
| 221 | "(let ((map #s(hash-table data (bar 1 baz 3)))) | ||
| 222 | (map-put! map 'foo 2) | ||
| 223 | map)") | ||
| 224 | (map-insert | ||
| 225 | :args (map key value) | ||
| 226 | :eval (map-insert (list 'bar 1 'baz 3 'foo 7) 'foo 2) | ||
| 227 | :eval (map-insert (list '(bar . 1) '(baz . 3) '(foo . 7)) 'foo 2) | ||
| 228 | :eval (map-insert [bar bot baz] 1 'foo) | ||
| 229 | :eval (map-insert #s(hash-table data (bar 1 baz 3 foo 7)) 'foo 2)) | ||
| 230 | (map-delete | ||
| 231 | :args (map key) | ||
| 232 | :eval (map-delete (list 'bar 1 'foo 2 'baz 3) 'foo) | ||
| 233 | :eval (map-delete (list '(bar . 1) '(foo . 2) '(baz . 3)) 'foo) | ||
| 234 | :eval (map-delete [bar foo baz] 1) | ||
| 235 | :eval (map-delete #s(hash-table data (bar 1 foo 2 baz 3)) 'foo)) | ||
| 236 | (map-keys | ||
| 237 | :eval (map-keys (list 'bar 1 'foo 2 'baz 3)) | ||
| 238 | :eval (map-keys (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 239 | :eval (map-keys [bar foo baz]) | ||
| 240 | :eval (map-keys #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 241 | (map-values | ||
| 242 | :args (map) | ||
| 243 | :eval (map-values (list 'bar 1 'foo 2 'baz 3)) | ||
| 244 | :eval (map-values (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 245 | :eval (map-values [bar foo baz]) | ||
| 246 | :eval (map-values #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 247 | (map-pairs | ||
| 248 | :eval (map-pairs (list 'bar 1 'foo 2 'baz 3)) | ||
| 249 | :eval (map-pairs (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 250 | :eval (map-pairs [bar foo baz]) | ||
| 251 | :eval (map-pairs #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 252 | (map-length | ||
| 253 | :args (map) | ||
| 254 | :eval (map-length (list 'bar 1 'foo 2 'baz 3)) | ||
| 255 | :eval (map-length (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 256 | :eval (map-length [bar foo baz]) | ||
| 257 | :eval (map-length #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 258 | (map-copy | ||
| 259 | :args (map) | ||
| 260 | :eval (map-copy (list 'bar 1 'foo 2 'baz 3)) | ||
| 261 | :eval (map-copy (list '(bar . 1) '(foo . 2) '(baz . 3))) | ||
| 262 | :eval (map-copy [bar foo baz]) | ||
| 263 | :eval (map-copy #s(hash-table data (bar 1 foo 2 baz 3)))) | ||
| 264 | "Doing things to maps and their contents" | ||
| 265 | (map-apply | ||
| 266 | :args (function map) | ||
| 267 | :eval (map-apply #'+ (list '(1 . 2) '(3 . 4)))) | ||
| 268 | (map-do | ||
| 269 | :args (function map) | ||
| 270 | :eval | ||
| 271 | "(let ((map (list '(1 . 1) '(2 . 3))) | ||
| 272 | acc) | ||
| 273 | (map-do (lambda (k v) (push (+ k v) acc)) map) | ||
| 274 | (nreverse acc))") | ||
| 275 | (map-keys-apply | ||
| 276 | :eval (map-keys-apply #'1+ (list '(1 . 2) '(3 . 4)))) | ||
| 277 | (map-values-apply | ||
| 278 | :args (function map) | ||
| 279 | :eval (map-values-apply #'1+ (list '(1 . 2) '(3 . 4)))) | ||
| 280 | (map-filter | ||
| 281 | :eval (map-filter (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) | ||
| 282 | :eval (map-filter (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) | ||
| 283 | (map-remove | ||
| 284 | :eval (map-remove (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) | ||
| 285 | :eval (map-remove (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) | ||
| 286 | (map-some | ||
| 287 | :eval (map-some (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) | ||
| 288 | :eval (map-some (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6)))) | ||
| 289 | (map-every-p | ||
| 290 | :eval (map-every-p (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6))) | ||
| 291 | :eval (map-every-p (lambda (k v) (evenp (+ k v))) (list '(1 . 3) '(4 . 6)))) | ||
| 292 | "Combining and changing maps" | ||
| 293 | (map-merge | ||
| 294 | :eval (map-merge 'alist '(1 2 3 4) #s(hash-table data (5 6 7 8))) | ||
| 295 | :eval (map-merge 'list '(1 2 3 4) #s(hash-table data (5 6 7 8))) | ||
| 296 | :eval (map-merge 'plist '(1 2 3 4) #s(hash-table data (5 6 7 8))) | ||
| 297 | :eval (map-merge 'hash-table '(1 2 3 4) #s(hash-table data (5 6 7 8)))) | ||
| 298 | (map-merge-with | ||
| 299 | :eval (map-merge-with 'alist #'max '(1 2 3 4) #s(hash-table data (1 1 3 5))) | ||
| 300 | :eval (map-merge-with 'alist #'min '(1 2 3 4) #s(hash-table data (1 1 3 5))) | ||
| 301 | :eval (map-merge-with 'hash-table #'min '(1 2 3 4) #s(hash-table data (1 1 3 5)))) | ||
| 302 | (map-into | ||
| 303 | :args (map type) | ||
| 304 | :eval (map-into #s(hash-table data '(5 6 7 8)) 'list) | ||
| 305 | :eval (map-into '((5 . 6) (7 . 8)) 'plist) | ||
| 306 | :eval (map-into '((5 . 6) (7 . 8)) 'hash-table))) | ||
| 307 | |||
| 308 | (define-short-documentation-group string | ||
| 309 | "Making Strings" | ||
| 310 | (make-string | ||
| 311 | :args (length init) | ||
| 312 | :eval "(make-string 5 ?x)") | ||
| 313 | (string | ||
| 314 | :eval "(string ?a ?b ?c)") | ||
| 315 | (concat | ||
| 316 | :eval (concat "foo" "bar" "zot")) | ||
| 317 | (string-join | ||
| 318 | :no-manual t | ||
| 319 | :eval (string-join '("foo" "bar" "zot") " ")) | ||
| 320 | (mapconcat | ||
| 321 | :eval (mapconcat (lambda (a) (concat "[" a "]")) | ||
| 322 | '("foo" "bar" "zot") " ")) | ||
| 323 | (string-pad | ||
| 324 | :eval (string-pad "foo" 5) | ||
| 325 | :eval (string-pad "foobar" 5) | ||
| 326 | :eval (string-pad "foo" 5 ?- t)) | ||
| 327 | (mapcar | ||
| 328 | :eval (mapcar #'identity "123")) | ||
| 329 | (format | ||
| 330 | :eval (format "This number is %d" 4)) | ||
| 331 | "Manipulating Strings" | ||
| 332 | (substring | ||
| 333 | :eval (substring "abcde" 1 3) | ||
| 334 | :eval (substring "abcde" 2) | ||
| 335 | :eval (substring "abcde" 1 -1) | ||
| 336 | :eval (substring "abcde" -4 4)) | ||
| 337 | (string-limit | ||
| 338 | :eval (string-limit "foobar" 3) | ||
| 339 | :eval (string-limit "foobar" 3 t) | ||
| 340 | :eval (string-limit "foobar" 10) | ||
| 341 | :eval (string-limit "fo好" 3 nil 'utf-8)) | ||
| 342 | (truncate-string-to-width | ||
| 343 | :eval (truncate-string-to-width "foobar" 3) | ||
| 344 | :eval (truncate-string-to-width "你好bar" 5)) | ||
| 345 | (split-string | ||
| 346 | :eval (split-string "foo bar") | ||
| 347 | :eval (split-string "|foo|bar|" "|") | ||
| 348 | :eval (split-string "|foo|bar|" "|" t)) | ||
| 349 | (split-string-and-unquote | ||
| 350 | :eval (split-string-and-unquote "foo \"bar zot\"")) | ||
| 351 | (split-string-shell-command | ||
| 352 | :eval (split-string-shell-command "ls /tmp/'foo bar'")) | ||
| 353 | (string-lines | ||
| 354 | :eval (string-lines "foo\n\nbar") | ||
| 355 | :eval (string-lines "foo\n\nbar" t)) | ||
| 356 | (string-replace | ||
| 357 | :eval (string-replace "foo" "bar" "foozot")) | ||
| 358 | (replace-regexp-in-string | ||
| 359 | :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) | ||
| 360 | (string-trim | ||
| 361 | :args (string) | ||
| 362 | :doc "Trim STRING of leading and trailing white space." | ||
| 363 | :eval (string-trim " foo ")) | ||
| 364 | (string-trim-left | ||
| 365 | :eval (string-trim-left "oofoo" "o+")) | ||
| 366 | (string-trim-right | ||
| 367 | :eval (string-trim-right "barkss" "s+")) | ||
| 368 | (string-truncate-left | ||
| 369 | :no-manual t | ||
| 370 | :eval (string-truncate-left "longstring" 8)) | ||
| 371 | (string-remove-suffix | ||
| 372 | :no-manual t | ||
| 373 | :eval (string-remove-suffix "bar" "foobar")) | ||
| 374 | (string-remove-prefix | ||
| 375 | :no-manual t | ||
| 376 | :eval (string-remove-prefix "foo" "foobar")) | ||
| 377 | (string-chop-newline | ||
| 378 | :eval (string-chop-newline "foo\n")) | ||
| 379 | (string-clean-whitespace | ||
| 380 | :eval (string-clean-whitespace " foo bar ")) | ||
| 381 | (string-fill | ||
| 382 | :eval (string-fill "Three short words" 12) | ||
| 383 | :eval (string-fill "Long-word" 3)) | ||
| 384 | (reverse | ||
| 385 | :eval (reverse "foo")) | ||
| 386 | (substring-no-properties | ||
| 387 | :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3)) | ||
| 388 | (try-completion | ||
| 389 | :eval (try-completion "foo" '("foobar" "foozot" "gazonk"))) | ||
| 390 | "Unicode Strings" | ||
| 391 | (string-glyph-split | ||
| 392 | :eval (string-glyph-split "Hello, 👼🏻🧑🏼🤝🧑🏻")) | ||
| 393 | (string-glyph-compose | ||
| 394 | :eval (string-glyph-compose "Å")) | ||
| 395 | (string-glyph-decompose | ||
| 396 | :eval (string-glyph-decompose "Å")) | ||
| 397 | "Predicates for Strings" | ||
| 398 | (string-equal | ||
| 399 | :eval (string-equal "abc" "abc") | ||
| 400 | :eval (string-equal "abc" "ABC")) | ||
| 401 | (string-equal-ignore-case | ||
| 402 | :eval (string-equal-ignore-case "foo" "FOO")) | ||
| 403 | (equal | ||
| 404 | :eval (equal "foo" "foo")) | ||
| 405 | (cl-equalp | ||
| 406 | :eval (cl-equalp "Foo" "foo")) | ||
| 407 | (stringp | ||
| 408 | :eval (stringp "a") | ||
| 409 | :eval (stringp 'a) | ||
| 410 | :eval "(stringp ?a)") | ||
| 411 | (string-or-null-p | ||
| 412 | :eval (string-or-null-p "a") | ||
| 413 | :eval (string-or-null-p nil)) | ||
| 414 | (char-or-string-p | ||
| 415 | :eval "(char-or-string-p ?a)" | ||
| 416 | :eval (char-or-string-p "a")) | ||
| 417 | (string-empty-p | ||
| 418 | :no-manual t | ||
| 419 | :eval (string-empty-p "")) | ||
| 420 | (string-blank-p | ||
| 421 | :no-manual t | ||
| 422 | :eval (string-blank-p " \n")) | ||
| 423 | (string-lessp | ||
| 424 | :eval (string-lessp "abc" "def") | ||
| 425 | :eval (string-lessp "pic4.png" "pic32.png") | ||
| 426 | :eval (string-lessp "1.1" "1.2")) | ||
| 427 | (string-greaterp | ||
| 428 | :eval (string-greaterp "foo" "bar")) | ||
| 429 | (string-version-lessp | ||
| 430 | :eval (string-version-lessp "pic4.png" "pic32.png") | ||
| 431 | :eval (string-version-lessp "1.9.3" "1.10.2")) | ||
| 432 | (string-collate-lessp | ||
| 433 | :eval (string-collate-lessp "abc" "abd")) | ||
| 434 | (string-prefix-p | ||
| 435 | :eval (string-prefix-p "foo" "foobar")) | ||
| 436 | (string-suffix-p | ||
| 437 | :eval (string-suffix-p "bar" "foobar")) | ||
| 438 | "Case Manipulation" | ||
| 439 | (upcase | ||
| 440 | :eval (upcase "foo")) | ||
| 441 | (downcase | ||
| 442 | :eval (downcase "FOObar")) | ||
| 443 | (capitalize | ||
| 444 | :eval (capitalize "foo bar zot")) | ||
| 445 | (upcase-initials | ||
| 446 | :eval (upcase-initials "The CAT in the hAt")) | ||
| 447 | "Converting Strings" | ||
| 448 | (string-to-number | ||
| 449 | :eval (string-to-number "42") | ||
| 450 | :eval (string-to-number "deadbeef" 16) | ||
| 451 | :eval (string-to-number "2.5e+03")) | ||
| 452 | (number-to-string | ||
| 453 | :eval (number-to-string 42)) | ||
| 454 | (char-uppercase-p | ||
| 455 | :eval "(char-uppercase-p ?A)" | ||
| 456 | :eval "(char-uppercase-p ?a)") | ||
| 457 | "Data About Strings" | ||
| 458 | (length | ||
| 459 | :eval (length "foo") | ||
| 460 | :eval (length "avocado: 🥑")) | ||
| 461 | (string-width | ||
| 462 | :eval (string-width "foo") | ||
| 463 | :eval (string-width "avocado: 🥑")) | ||
| 464 | (string-pixel-width | ||
| 465 | :eval (string-pixel-width "foo") | ||
| 466 | :eval (string-pixel-width "avocado: 🥑")) | ||
| 467 | (string-search | ||
| 468 | :eval (string-search "bar" "foobarzot")) | ||
| 469 | (assoc-string | ||
| 470 | :eval (assoc-string "foo" '(("a" 1) (foo 2)))) | ||
| 471 | (seq-position | ||
| 472 | :eval "(seq-position \"foobarzot\" ?z)")) | ||
| 473 | |||
| 474 | (define-short-documentation-group file-name | ||
| 475 | "File Name Manipulation" | ||
| 476 | (file-name-directory | ||
| 477 | :eval (file-name-directory "/tmp/foo") | ||
| 478 | :eval (file-name-directory "/tmp/foo/")) | ||
| 479 | (file-name-nondirectory | ||
| 480 | :eval (file-name-nondirectory "/tmp/foo") | ||
| 481 | :eval (file-name-nondirectory "/tmp/foo/")) | ||
| 482 | (file-name-sans-versions | ||
| 483 | :args (filename) | ||
| 484 | :eval (file-name-sans-versions "/tmp/foo~")) | ||
| 485 | (file-name-extension | ||
| 486 | :eval (file-name-extension "/tmp/foo.txt")) | ||
| 487 | (file-name-sans-extension | ||
| 488 | :eval (file-name-sans-extension "/tmp/foo.txt")) | ||
| 489 | (file-name-with-extension | ||
| 490 | :eval (file-name-with-extension "foo.txt" "bin") | ||
| 491 | :eval (file-name-with-extension "foo" "bin")) | ||
| 492 | (file-name-base | ||
| 493 | :eval (file-name-base "/tmp/foo.txt")) | ||
| 494 | (file-relative-name | ||
| 495 | :eval (file-relative-name "/tmp/foo" "/tmp")) | ||
| 496 | (file-name-split | ||
| 497 | :eval (file-name-split "/tmp/foo") | ||
| 498 | :eval (file-name-split "foo/bar")) | ||
| 499 | (make-temp-name | ||
| 500 | :eval (make-temp-name "/tmp/foo-")) | ||
| 501 | (file-name-concat | ||
| 502 | :eval (file-name-concat "/tmp/" "foo") | ||
| 503 | :eval (file-name-concat "/tmp" "foo") | ||
| 504 | :eval (file-name-concat "/tmp" "foo" "bar/" "zot") | ||
| 505 | :eval (file-name-concat "/tmp" "~")) | ||
| 506 | (expand-file-name | ||
| 507 | :eval (expand-file-name "foo" "/tmp/") | ||
| 508 | :eval (expand-file-name "foo" "/tmp///") | ||
| 509 | :eval (expand-file-name "foo" "/tmp/foo/.././") | ||
| 510 | :eval (expand-file-name "~" "/tmp/")) | ||
| 511 | (substitute-in-file-name | ||
| 512 | :eval (substitute-in-file-name "$HOME/foo")) | ||
| 513 | "Directory Functions" | ||
| 514 | (file-name-as-directory | ||
| 515 | :eval (file-name-as-directory "/tmp/foo")) | ||
| 516 | (directory-file-name | ||
| 517 | :eval (directory-file-name "/tmp/foo/")) | ||
| 518 | (abbreviate-file-name | ||
| 519 | :no-eval (abbreviate-file-name "/home/some-user") | ||
| 520 | :eg-result "~some-user") | ||
| 521 | (file-name-parent-directory | ||
| 522 | :eval (file-name-parent-directory "/foo/bar") | ||
| 523 | :eval (file-name-parent-directory "/foo/") | ||
| 524 | :eval (file-name-parent-directory "foo/bar") | ||
| 525 | :eval (file-name-parent-directory "foo")) | ||
| 526 | "Quoted File Names" | ||
| 527 | (file-name-quote | ||
| 528 | :args (name) | ||
| 529 | :eval (file-name-quote "/tmp/foo")) | ||
| 530 | (file-name-unquote | ||
| 531 | :args (name) | ||
| 532 | :eval (file-name-unquote "/:/tmp/foo")) | ||
| 533 | "Predicates" | ||
| 534 | (file-name-absolute-p | ||
| 535 | :eval (file-name-absolute-p "/tmp/foo") | ||
| 536 | :eval (file-name-absolute-p "foo")) | ||
| 537 | (directory-name-p | ||
| 538 | :eval (directory-name-p "/tmp/foo/")) | ||
| 539 | (file-name-quoted-p | ||
| 540 | :eval (file-name-quoted-p "/:/tmp/foo"))) | ||
| 541 | |||
| 542 | (define-short-documentation-group file | ||
| 543 | "Inserting Contents" | ||
| 544 | (insert-file-contents | ||
| 545 | :no-eval (insert-file-contents "/tmp/foo") | ||
| 546 | :eg-result ("/tmp/foo" 6)) | ||
| 547 | (insert-file-contents-literally | ||
| 548 | :no-eval (insert-file-contents-literally "/tmp/foo") | ||
| 549 | :eg-result ("/tmp/foo" 6)) | ||
| 550 | (find-file | ||
| 551 | :no-eval (find-file "/tmp/foo") | ||
| 552 | :eg-result-string "#<buffer foo>") | ||
| 553 | "Predicates" | ||
| 554 | (file-symlink-p | ||
| 555 | :no-eval (file-symlink-p "/tmp/foo") | ||
| 556 | :eg-result t) | ||
| 557 | (file-directory-p | ||
| 558 | :no-eval (file-directory-p "/tmp") | ||
| 559 | :eg-result t) | ||
| 560 | (file-regular-p | ||
| 561 | :no-eval (file-regular-p "/tmp/foo") | ||
| 562 | :eg-result t) | ||
| 563 | (file-exists-p | ||
| 564 | :no-eval (file-exists-p "/tmp/foo") | ||
| 565 | :eg-result t) | ||
| 566 | (file-readable-p | ||
| 567 | :no-eval (file-readable-p "/tmp/foo") | ||
| 568 | :eg-result t) | ||
| 569 | (file-writable-p | ||
| 570 | :no-eval (file-writable-p "/tmp/foo") | ||
| 571 | :eg-result t) | ||
| 572 | (file-accessible-directory-p | ||
| 573 | :no-eval (file-accessible-directory-p "/tmp") | ||
| 574 | :eg-result t) | ||
| 575 | (file-executable-p | ||
| 576 | :no-eval (file-executable-p "/bin/cat") | ||
| 577 | :eg-result t) | ||
| 578 | (file-newer-than-file-p | ||
| 579 | :no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar") | ||
| 580 | :eg-result nil) | ||
| 581 | (file-has-changed-p | ||
| 582 | :no-eval (file-has-changed-p "/tmp/foo") | ||
| 583 | :eg-result t) | ||
| 584 | (file-equal-p | ||
| 585 | :no-eval (file-equal-p "/tmp/foo" "/tmp/bar") | ||
| 586 | :eg-result nil) | ||
| 587 | (file-in-directory-p | ||
| 588 | :no-eval (file-in-directory-p "/tmp/foo" "/tmp/") | ||
| 589 | :eg-result t) | ||
| 590 | (file-locked-p | ||
| 591 | :no-eval (file-locked-p "/tmp/foo") | ||
| 592 | :eg-result nil) | ||
| 593 | "Information" | ||
| 594 | (file-attributes | ||
| 595 | :no-eval* (file-attributes "/tmp")) | ||
| 596 | (file-truename | ||
| 597 | :no-eval (file-truename "/tmp/foo/bar") | ||
| 598 | :eg-result "/tmp/foo/zot") | ||
| 599 | (file-chase-links | ||
| 600 | :no-eval (file-chase-links "/tmp/foo/bar") | ||
| 601 | :eg-result "/tmp/foo/zot") | ||
| 602 | (vc-responsible-backend | ||
| 603 | :args (file &optional no-error) | ||
| 604 | :no-eval (vc-responsible-backend "/src/foo/bar.c") | ||
| 605 | :eg-result Git) | ||
| 606 | (file-acl | ||
| 607 | :no-eval (file-acl "/tmp/foo") | ||
| 608 | :eg-result "user::rw-\ngroup::r--\nother::r--\n") | ||
| 609 | (file-extended-attributes | ||
| 610 | :no-eval* (file-extended-attributes "/tmp/foo")) | ||
| 611 | (file-selinux-context | ||
| 612 | :no-eval* (file-selinux-context "/tmp/foo")) | ||
| 613 | (locate-file | ||
| 614 | :no-eval (locate-file "syslog" '("/var/log" "/usr/bin")) | ||
| 615 | :eg-result "/var/log/syslog") | ||
| 616 | (executable-find | ||
| 617 | :no-eval (executable-find "ls") | ||
| 618 | :eg-result "/usr/bin/ls") | ||
| 619 | "Creating" | ||
| 620 | (make-temp-file | ||
| 621 | :no-eval (make-temp-file "/tmp/foo-") | ||
| 622 | :eg-result "/tmp/foo-ZcXFMj") | ||
| 623 | (make-nearby-temp-file | ||
| 624 | :no-eval (make-nearby-temp-file "/tmp/foo-") | ||
| 625 | :eg-result "/tmp/foo-xe8iON") | ||
| 626 | (write-region | ||
| 627 | :no-value (write-region (point-min) (point-max) "/tmp/foo")) | ||
| 628 | "Directories" | ||
| 629 | (make-directory | ||
| 630 | :no-value (make-directory "/tmp/bar/zot/" t)) | ||
| 631 | (directory-files | ||
| 632 | :no-eval (directory-files "/tmp/") | ||
| 633 | :eg-result ("." ".." ".ICE-unix" ".Test-unix")) | ||
| 634 | (directory-files-recursively | ||
| 635 | :no-eval (directory-files-recursively "/tmp/" "\\.png\\'") | ||
| 636 | :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png")) | ||
| 637 | (directory-files-and-attributes | ||
| 638 | :no-eval* (directory-files-and-attributes "/tmp/foo")) | ||
| 639 | (file-expand-wildcards | ||
| 640 | :no-eval (file-expand-wildcards "/tmp/*.png") | ||
| 641 | :eg-result ("/tmp/foo.png" "/tmp/zot.png") | ||
| 642 | :no-eval (file-expand-wildcards "/*/foo.png") | ||
| 643 | :eg-result ("/tmp/foo.png" "/var/foo.png")) | ||
| 644 | (locate-dominating-file | ||
| 645 | :no-eval (locate-dominating-file "foo.png" "/tmp/foo/bar/zot") | ||
| 646 | :eg-result "/tmp/foo.png") | ||
| 647 | (copy-directory | ||
| 648 | :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy")) | ||
| 649 | (delete-directory | ||
| 650 | :no-value (delete-directory "/tmp/bar/")) | ||
| 651 | "File Operations" | ||
| 652 | (rename-file | ||
| 653 | :no-value (rename-file "/tmp/foo" "/tmp/newname")) | ||
| 654 | (copy-file | ||
| 655 | :no-value (copy-file "/tmp/foo" "/tmp/foocopy")) | ||
| 656 | (delete-file | ||
| 657 | :no-value (delete-file "/tmp/foo")) | ||
| 658 | (make-empty-file | ||
| 659 | :no-value (make-empty-file "/tmp/foo")) | ||
| 660 | (make-symbolic-link | ||
| 661 | :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink")) | ||
| 662 | (add-name-to-file | ||
| 663 | :no-value (add-name-to-file "/tmp/foo" "/tmp/bar")) | ||
| 664 | (set-file-modes | ||
| 665 | :no-value "(set-file-modes \"/tmp/foo\" #o644)") | ||
| 666 | (set-file-times | ||
| 667 | :no-value (set-file-times "/tmp/foo")) | ||
| 668 | "File Modes" | ||
| 669 | (set-default-file-modes | ||
| 670 | :no-value "(set-default-file-modes #o755)") | ||
| 671 | (default-file-modes | ||
| 672 | :no-eval (default-file-modes) | ||
| 673 | :eg-result-string "#o755") | ||
| 674 | (file-modes-symbolic-to-number | ||
| 675 | :no-eval (file-modes-symbolic-to-number "a+r") | ||
| 676 | :eg-result-string "#o444") | ||
| 677 | (file-modes-number-to-symbolic | ||
| 678 | :eval "(file-modes-number-to-symbolic #o444)") | ||
| 679 | (set-file-extended-attributes | ||
| 680 | :no-eval (set-file-extended-attributes | ||
| 681 | "/tmp/foo" '((acl . "group::rxx"))) | ||
| 682 | :eg-result t) | ||
| 683 | (set-file-selinux-context | ||
| 684 | :no-eval (set-file-selinux-context | ||
| 685 | "/tmp/foo" '(unconfined_u object_r user_home_t s0)) | ||
| 686 | :eg-result t) | ||
| 687 | (set-file-acl | ||
| 688 | :no-eval (set-file-acl "/tmp/foo" "group::rxx") | ||
| 689 | :eg-result t)) | ||
| 690 | |||
| 691 | (define-short-documentation-group hash-table | ||
| 692 | "Hash Table Basics" | ||
| 693 | (make-hash-table | ||
| 694 | :no-eval (make-hash-table) | ||
| 695 | :result-string "#s(hash-table ...)") | ||
| 696 | (puthash | ||
| 697 | :no-eval (puthash 'key "value" table)) | ||
| 698 | (gethash | ||
| 699 | :no-eval (gethash 'key table) | ||
| 700 | :eg-result "value") | ||
| 701 | (remhash | ||
| 702 | :no-eval (remhash 'key table) | ||
| 703 | :result nil) | ||
| 704 | (clrhash | ||
| 705 | :no-eval (clrhash table) | ||
| 706 | :result-string "#s(hash-table ...)") | ||
| 707 | (maphash | ||
| 708 | :no-eval (maphash (lambda (key value) (message value)) table) | ||
| 709 | :result nil) | ||
| 710 | "Other Hash Table Functions" | ||
| 711 | (hash-table-p | ||
| 712 | :eval (hash-table-p 123)) | ||
| 713 | (hash-table-contains-p | ||
| 714 | :no-eval (hash-table-contains-p 'key table)) | ||
| 715 | (copy-hash-table | ||
| 716 | :no-eval (copy-hash-table table) | ||
| 717 | :result-string "#s(hash-table ...)") | ||
| 718 | (hash-table-count | ||
| 719 | :no-eval (hash-table-count table) | ||
| 720 | :eg-result 15)) | ||
| 721 | |||
| 722 | (define-short-documentation-group list | ||
| 723 | "Making Lists" | ||
| 724 | (make-list | ||
| 725 | :eval (make-list 5 'a)) | ||
| 726 | (cons | ||
| 727 | :eval (cons 1 '(2 3 4))) | ||
| 728 | (list | ||
| 729 | :eval (list 1 2 3)) | ||
| 730 | (number-sequence | ||
| 731 | :eval (number-sequence 5 8)) | ||
| 732 | (ensure-list | ||
| 733 | :eval (ensure-list "foo") | ||
| 734 | :eval (ensure-list '(1 2 3)) | ||
| 735 | :eval (ensure-list '(1 . 2))) | ||
| 736 | (ensure-proper-list | ||
| 737 | :eval (ensure-proper-list "foo") | ||
| 738 | :eval (ensure-proper-list '(1 2 3)) | ||
| 739 | :eval (ensure-proper-list '(1 . 2))) | ||
| 740 | "Operations on Lists" | ||
| 741 | (append | ||
| 742 | :eval (append '("foo" "bar") '("zot"))) | ||
| 743 | (copy-tree | ||
| 744 | :eval (copy-tree '(1 (2 3) 4))) | ||
| 745 | (flatten-tree | ||
| 746 | :eval (flatten-tree '(1 (2 3) 4))) | ||
| 747 | (car | ||
| 748 | :eval (car '(one two three)) | ||
| 749 | :eval (car '(one . two)) | ||
| 750 | :eval (car nil)) | ||
| 751 | (cdr | ||
| 752 | :eval (cdr '(one two three)) | ||
| 753 | :eval (cdr '(one . two)) | ||
| 754 | :eval (cdr nil)) | ||
| 755 | (last | ||
| 756 | :eval (last '(one two three))) | ||
| 757 | (butlast | ||
| 758 | :eval (butlast '(one two three))) | ||
| 759 | (nbutlast | ||
| 760 | :eval (nbutlast (list 'one 'two 'three))) | ||
| 761 | (nth | ||
| 762 | :eval (nth 1 '(one two three))) | ||
| 763 | (nthcdr | ||
| 764 | :eval (nthcdr 1 '(one two three))) | ||
| 765 | (take | ||
| 766 | :eval (take 3 '(one two three four))) | ||
| 767 | (ntake | ||
| 768 | :eval (ntake 3 (list 'one 'two 'three 'four))) | ||
| 769 | (take-while | ||
| 770 | :eval (take-while #'numberp '(1 2 three 4 five))) | ||
| 771 | (drop-while | ||
| 772 | :eval (drop-while #'numberp '(1 2 three 4 five))) | ||
| 773 | (any | ||
| 774 | :eval (any #'symbolp '(1 2 three 4 five))) | ||
| 775 | (all | ||
| 776 | :eval (all #'symbolp '(one 2 three)) | ||
| 777 | :eval (all #'symbolp '(one two three))) | ||
| 778 | (elt | ||
| 779 | :eval (elt '(one two three) 1)) | ||
| 780 | (car-safe | ||
| 781 | :eval (car-safe '(one two three))) | ||
| 782 | (cdr-safe | ||
| 783 | :eval (cdr-safe '(one two three))) | ||
| 784 | (push | ||
| 785 | :no-eval* (push 'a list)) | ||
| 786 | (pop | ||
| 787 | :no-eval* (pop list)) | ||
| 788 | (setcar | ||
| 789 | :no-eval (setcar list 'c) | ||
| 790 | :result c) | ||
| 791 | (setcdr | ||
| 792 | :no-eval (setcdr list (list c)) | ||
| 793 | :result '(c)) | ||
| 794 | (nconc | ||
| 795 | :eval (nconc (list 1) (list 2 3 4))) | ||
| 796 | (delq | ||
| 797 | :eval (delq 'a (list 'a 'b 'c 'd))) | ||
| 798 | (delete | ||
| 799 | :eval (delete 2 (list 1 2 3 4)) | ||
| 800 | :eval (delete "a" (list "a" "b" "c" "d"))) | ||
| 801 | (remq | ||
| 802 | :eval (remq 'b '(a b c))) | ||
| 803 | (remove | ||
| 804 | :eval (remove 2 '(1 2 3 4)) | ||
| 805 | :eval (remove "a" '("a" "b" "c" "d"))) | ||
| 806 | (delete-dups | ||
| 807 | :eval (delete-dups (list 1 2 4 3 2 4))) | ||
| 808 | "Mapping Over Lists" | ||
| 809 | (mapcar | ||
| 810 | :eval (mapcar #'list '(1 2 3))) | ||
| 811 | (mapcan | ||
| 812 | :eval (mapcan #'list '(1 2 3))) | ||
| 813 | (mapc | ||
| 814 | :eval (mapc #'insert '("1" "2" "3"))) | ||
| 815 | (seq-reduce | ||
| 816 | :eval (seq-reduce #'+ '(1 2 3) 0)) | ||
| 817 | (mapconcat | ||
| 818 | :eval (mapconcat #'identity '("foo" "bar") "|")) | ||
| 819 | "Predicates" | ||
| 820 | (listp | ||
| 821 | :eval (listp '(1 2 3)) | ||
| 822 | :eval (listp nil) | ||
| 823 | :eval (listp '(1 . 2))) | ||
| 824 | (consp | ||
| 825 | :eval (consp '(1 2 3)) | ||
| 826 | :eval (consp nil)) | ||
| 827 | (proper-list-p | ||
| 828 | :eval (proper-list-p '(1 2 3)) | ||
| 829 | :eval (proper-list-p nil) | ||
| 830 | :eval (proper-list-p '(1 . 2))) | ||
| 831 | (null | ||
| 832 | :eval (null nil)) | ||
| 833 | (atom | ||
| 834 | :eval (atom 'a)) | ||
| 835 | (nlistp | ||
| 836 | :eval (nlistp '(1 2 3)) | ||
| 837 | :eval (nlistp t) | ||
| 838 | :eval (nlistp '(1 . 2))) | ||
| 839 | "Finding Elements" | ||
| 840 | (memq | ||
| 841 | :eval (memq 'b '(a b c))) | ||
| 842 | (memql | ||
| 843 | :eval (memql 2.0 '(1.0 2.0 3.0))) | ||
| 844 | (member | ||
| 845 | :eval (member 2 '(1 2 3)) | ||
| 846 | :eval (member "b" '("a" "b" "c"))) | ||
| 847 | (member-ignore-case | ||
| 848 | :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) | ||
| 849 | "Association Lists" | ||
| 850 | (assoc | ||
| 851 | :eval (assoc "b" '(("a" . 1) ("b" . 2)))) | ||
| 852 | (rassoc | ||
| 853 | :eval (rassoc "b" '((1 . "a") (2 . "b")))) | ||
| 854 | (assq | ||
| 855 | :eval (assq 'b '((a . 1) (b . 2)))) | ||
| 856 | (rassq | ||
| 857 | :eval (rassq 'b '((1 . a) (2 . b)))) | ||
| 858 | (assoc-string | ||
| 859 | :eval (assoc-string "foo" '(("a" 1) (foo 2)))) | ||
| 860 | (alist-get | ||
| 861 | :eval (alist-get 2 '((1 . a) (2 . b)))) | ||
| 862 | (assoc-default | ||
| 863 | :eval (assoc-default 2 '((1 . a) (2 . b) #'=))) | ||
| 864 | (copy-alist | ||
| 865 | :eval (copy-alist '((1 . a) (2 . b)))) | ||
| 866 | (assoc-delete-all | ||
| 867 | :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c)))) | ||
| 868 | (assq-delete-all | ||
| 869 | :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c)))) | ||
| 870 | (rassq-delete-all | ||
| 871 | :eval (rassq-delete-all 'b (list '(1 . a) '(2 . b) '(2 . c)))) | ||
| 872 | "Property Lists" | ||
| 873 | (plist-get | ||
| 874 | :eval (plist-get '(a 1 b 2 c 3) 'b)) | ||
| 875 | (plist-put | ||
| 876 | :no-eval (setq plist (plist-put plist 'd 4)) | ||
| 877 | :eg-result (a 1 b 2 c 3 d 4)) | ||
| 878 | (plist-member | ||
| 879 | :eval (plist-member '(a 1 b 2 c 3) 'b)) | ||
| 880 | "Data About Lists" | ||
| 881 | (length | ||
| 882 | :eval (length '(a b c))) | ||
| 883 | (length< | ||
| 884 | :eval (length< '(a b c) 1)) | ||
| 885 | (length> | ||
| 886 | :eval (length> '(a b c) 1)) | ||
| 887 | (length= | ||
| 888 | :eval (length= '(a b c) 3)) | ||
| 889 | (safe-length | ||
| 890 | :eval (safe-length '(a b c)))) | ||
| 891 | |||
| 892 | (define-short-documentation-group symbol | ||
| 893 | "Making symbols" | ||
| 894 | (intern | ||
| 895 | :eval (intern "abc")) | ||
| 896 | (intern-soft | ||
| 897 | :eval (intern-soft "list") | ||
| 898 | :eval (intern-soft "Phooey!")) | ||
| 899 | (make-symbol | ||
| 900 | :eval (make-symbol "abc")) | ||
| 901 | (gensym | ||
| 902 | :no-eval (gensym) | ||
| 903 | :eg-result g37) | ||
| 904 | "Comparing symbols" | ||
| 905 | (eq | ||
| 906 | :eval (eq 'abc 'abc) | ||
| 907 | :eval (eq 'abc 'abd)) | ||
| 908 | (eql | ||
| 909 | :eval (eql 'abc 'abc)) | ||
| 910 | (equal | ||
| 911 | :eval (equal 'abc 'abc)) | ||
| 912 | "Name" | ||
| 913 | (symbol-name | ||
| 914 | :eval (symbol-name 'abc)) | ||
| 915 | "Obarrays" | ||
| 916 | (obarray-make | ||
| 917 | :eval (obarray-make)) | ||
| 918 | (obarrayp | ||
| 919 | :eval (obarrayp (obarray-make)) | ||
| 920 | :eval (obarrayp nil)) | ||
| 921 | (unintern | ||
| 922 | :no-eval (unintern "abc" my-obarray) | ||
| 923 | :eg-result t) | ||
| 924 | (mapatoms | ||
| 925 | :no-eval (mapatoms (lambda (symbol) (print symbol)) my-obarray)) | ||
| 926 | (obarray-clear | ||
| 927 | :no-eval (obarray-clear my-obarray))) | ||
| 928 | |||
| 929 | (define-short-documentation-group comparison | ||
| 930 | "General-purpose" | ||
| 931 | (eq | ||
| 932 | :eval (eq 'a 'a) | ||
| 933 | :eval "(eq ?A ?A)" | ||
| 934 | :eval (let ((x (list 'a "b" '(c) 4 5.0))) | ||
| 935 | (eq x x))) | ||
| 936 | (eql | ||
| 937 | :eval (eql 2 2) | ||
| 938 | :eval (eql 2.0 2.0) | ||
| 939 | :eval (eql 2.0 2)) | ||
| 940 | (equal | ||
| 941 | :eval (equal "abc" "abc") | ||
| 942 | :eval (equal 2.0 2.0) | ||
| 943 | :eval (equal 2.0 2) | ||
| 944 | :eval (equal '(a "b" (c) 4.0) '(a "b" (c) 4.0))) | ||
| 945 | (cl-equalp | ||
| 946 | :eval (cl-equalp 2 2.0) | ||
| 947 | :eval (cl-equalp "ABC" "abc")) | ||
| 948 | "Numeric" | ||
| 949 | (= | ||
| 950 | :args (number &rest numbers) | ||
| 951 | :eval (= 2 2) | ||
| 952 | :eval (= 2.0 2.0) | ||
| 953 | :eval (= 2.0 2) | ||
| 954 | :eval (= 4 4 4 4)) | ||
| 955 | (/= | ||
| 956 | :eval (/= 4 4)) | ||
| 957 | (< | ||
| 958 | :args (number &rest numbers) | ||
| 959 | :eval (< 4 4) | ||
| 960 | :eval (< 1 2 3)) | ||
| 961 | (<= | ||
| 962 | :args (number &rest numbers) | ||
| 963 | :eval (<= 4 4) | ||
| 964 | :eval (<= 1 2 2 3)) | ||
| 965 | (> | ||
| 966 | :args (number &rest numbers) | ||
| 967 | :eval (> 4 4) | ||
| 968 | :eval (> 3 2 1)) | ||
| 969 | (>= | ||
| 970 | :args (number &rest numbers) | ||
| 971 | :eval (>= 4 4) | ||
| 972 | :eval (>= 3 2 2 1)) | ||
| 973 | "String" | ||
| 974 | (string-equal | ||
| 975 | :eval (string-equal "abc" "abc") | ||
| 976 | :eval (string-equal "abc" "ABC")) | ||
| 977 | (string-equal-ignore-case | ||
| 978 | :eval (string-equal-ignore-case "abc" "ABC")) | ||
| 979 | (string-lessp | ||
| 980 | :eval (string-lessp "abc" "abd") | ||
| 981 | :eval (string-lessp "abc" "abc") | ||
| 982 | :eval (string-lessp "pic4.png" "pic32.png")) | ||
| 983 | (string-greaterp | ||
| 984 | :eval (string-greaterp "abd" "abc") | ||
| 985 | :eval (string-greaterp "abc" "abc")) | ||
| 986 | (string-version-lessp | ||
| 987 | :eval (string-version-lessp "pic4.png" "pic32.png") | ||
| 988 | :eval (string-version-lessp "1.9.3" "1.10.2")) | ||
| 989 | (string-collate-lessp | ||
| 990 | :eval (string-collate-lessp "abc" "abd"))) | ||
| 991 | |||
| 992 | (define-short-documentation-group vector | ||
| 993 | "Making Vectors" | ||
| 994 | (make-vector | ||
| 995 | :eval (make-vector 5 "foo")) | ||
| 996 | (vector | ||
| 997 | :eval (vector 1 "b" 3)) | ||
| 998 | "Operations on Vectors" | ||
| 999 | (vectorp | ||
| 1000 | :eval (vectorp [1]) | ||
| 1001 | :eval (vectorp "1")) | ||
| 1002 | (vconcat | ||
| 1003 | :eval (vconcat '(1 2) [3 4])) | ||
| 1004 | (append | ||
| 1005 | :eval (append [1 2] nil)) | ||
| 1006 | (length | ||
| 1007 | :eval (length [1 2 3])) | ||
| 1008 | (seq-reduce | ||
| 1009 | :eval (seq-reduce #'+ [1 2 3] 0)) | ||
| 1010 | (seq-subseq | ||
| 1011 | :eval (seq-subseq [1 2 3 4 5] 1 3) | ||
| 1012 | :eval (seq-subseq [1 2 3 4 5] 1)) | ||
| 1013 | (copy-tree | ||
| 1014 | :eval (copy-tree [1 (2 3) [4 5]] t)) | ||
| 1015 | "Mapping Over Vectors" | ||
| 1016 | (mapcar | ||
| 1017 | :eval (mapcar #'identity [1 2 3])) | ||
| 1018 | (mapc | ||
| 1019 | :eval (mapc #'insert ["1" "2" "3"]))) | ||
| 1020 | |||
| 1021 | (define-short-documentation-group regexp | ||
| 1022 | "Matching Strings" | ||
| 1023 | (replace-regexp-in-string | ||
| 1024 | :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*")) | ||
| 1025 | (string-match-p | ||
| 1026 | :eval (string-match-p "^[fo]+" "foobar")) | ||
| 1027 | "Looking in Buffers" | ||
| 1028 | (re-search-forward | ||
| 1029 | :no-eval (re-search-forward "^foo$" nil t) | ||
| 1030 | :eg-result 43) | ||
| 1031 | (re-search-backward | ||
| 1032 | :no-eval (re-search-backward "^foo$" nil t) | ||
| 1033 | :eg-result 43) | ||
| 1034 | (looking-at-p | ||
| 1035 | :no-eval (looking-at-p "f[0-9]") | ||
| 1036 | :eg-result t) | ||
| 1037 | "Match Data" | ||
| 1038 | (match-string | ||
| 1039 | :eval (and (string-match "^\\([fo]+\\)b" "foobar") | ||
| 1040 | (match-string 0 "foobar"))) | ||
| 1041 | (match-beginning | ||
| 1042 | :no-eval (match-beginning 1) | ||
| 1043 | :eg-result 0) | ||
| 1044 | (match-end | ||
| 1045 | :no-eval (match-end 1) | ||
| 1046 | :eg-result 3) | ||
| 1047 | (save-match-data | ||
| 1048 | :no-eval (save-match-data ...)) | ||
| 1049 | "Replacing Match" | ||
| 1050 | (replace-match | ||
| 1051 | :no-eval (replace-match "new") | ||
| 1052 | :eg-result nil) | ||
| 1053 | (match-substitute-replacement | ||
| 1054 | :no-eval (match-substitute-replacement "new") | ||
| 1055 | :eg-result "new") | ||
| 1056 | (replace-regexp-in-region | ||
| 1057 | :no-value (replace-regexp-in-region "[0-9]+" "Num \\&")) | ||
| 1058 | "Utilities" | ||
| 1059 | (regexp-quote | ||
| 1060 | :eval (regexp-quote "foo.*bar")) | ||
| 1061 | (regexp-opt | ||
| 1062 | :eval (regexp-opt '("foo" "bar"))) | ||
| 1063 | (regexp-opt-depth | ||
| 1064 | :eval (regexp-opt-depth "\\(a\\(b\\)\\)")) | ||
| 1065 | (regexp-opt-charset | ||
| 1066 | :eval (regexp-opt-charset '(?a ?b ?c ?d ?e))) | ||
| 1067 | "The `rx' Structured Regexp Notation" | ||
| 1068 | (rx | ||
| 1069 | :eval (rx "IP=" (+ digit) (= 3 "." (+ digit)))) | ||
| 1070 | (rx-to-string | ||
| 1071 | :eval (rx-to-string '(| "foo" "bar"))) | ||
| 1072 | (rx-define | ||
| 1073 | :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl))) | ||
| 1074 | (rx haskell-comment))" | ||
| 1075 | :result "--.*") | ||
| 1076 | (rx-let | ||
| 1077 | :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item))) | ||
| 1078 | (number (1+ digit)) | ||
| 1079 | (numbers (comma-separated number))) | ||
| 1080 | (rx \"(\" numbers \")\"))" | ||
| 1081 | :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)") | ||
| 1082 | (rx-let-eval | ||
| 1083 | :eval "(rx-let-eval | ||
| 1084 | '((ponder (x) (seq \"Where have all the \" x \" gone?\"))) | ||
| 1085 | (rx-to-string | ||
| 1086 | '(ponder (or \"flowers\" \"cars\" \"socks\"))))" | ||
| 1087 | :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)")) | ||
| 1088 | |||
| 1089 | (define-short-documentation-group sequence | ||
| 1090 | "Sequence Predicates" | ||
| 1091 | (seq-contains-p | ||
| 1092 | :eval (seq-contains-p '(a b c) 'b) | ||
| 1093 | :eval (seq-contains-p '(a b c) 'd)) | ||
| 1094 | (seq-every-p | ||
| 1095 | :eval (seq-every-p #'numberp '(1 2 3))) | ||
| 1096 | (seq-empty-p | ||
| 1097 | :eval (seq-empty-p [])) | ||
| 1098 | (seq-set-equal-p | ||
| 1099 | :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) | ||
| 1100 | (seq-some | ||
| 1101 | :eval (seq-some #'floatp '(1 2.0 3))) | ||
| 1102 | "Building Sequences" | ||
| 1103 | (seq-concatenate | ||
| 1104 | :eval (seq-concatenate 'vector '(1 2) '(c d))) | ||
| 1105 | (seq-copy | ||
| 1106 | :eval (seq-copy '(a 2))) | ||
| 1107 | (seq-into | ||
| 1108 | :eval (seq-into '(1 2 3) 'vector)) | ||
| 1109 | "Utility Functions" | ||
| 1110 | (seq-count | ||
| 1111 | :eval (seq-count #'numberp '(1 b c 4))) | ||
| 1112 | (seq-elt | ||
| 1113 | :eval (seq-elt '(a b c) 1)) | ||
| 1114 | (seq-random-elt | ||
| 1115 | :no-eval (seq-random-elt '(a b c)) | ||
| 1116 | :eg-result c) | ||
| 1117 | (seq-find | ||
| 1118 | :eval (seq-find #'numberp '(a b 3 4 f 6))) | ||
| 1119 | (seq-position | ||
| 1120 | :eval (seq-position '(a b c) 'c)) | ||
| 1121 | (seq-positions | ||
| 1122 | :eval (seq-positions '(a b c a d) 'a) | ||
| 1123 | :eval (seq-positions '(a b c a d) 'z) | ||
| 1124 | :eval (seq-positions '(11 5 7 12 9 15) 10 #'>=)) | ||
| 1125 | (seq-length | ||
| 1126 | :eval (seq-length "abcde")) | ||
| 1127 | (seq-max | ||
| 1128 | :eval (seq-max [1 2 3])) | ||
| 1129 | (seq-min | ||
| 1130 | :eval (seq-min [1 2 3])) | ||
| 1131 | (seq-first | ||
| 1132 | :eval (seq-first [a b c])) | ||
| 1133 | (seq-rest | ||
| 1134 | :eval (seq-rest '[1 2 3])) | ||
| 1135 | (seq-reverse | ||
| 1136 | :eval (seq-reverse '(1 2 3))) | ||
| 1137 | (seq-sort | ||
| 1138 | :eval (seq-sort #'> '(1 2 3))) | ||
| 1139 | (seq-sort-by | ||
| 1140 | :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3))) | ||
| 1141 | "Mapping Over Sequences" | ||
| 1142 | (seq-map | ||
| 1143 | :eval (seq-map #'1+ '(1 2 3))) | ||
| 1144 | (seq-map-indexed | ||
| 1145 | :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c))) | ||
| 1146 | (seq-mapcat | ||
| 1147 | :eval (seq-mapcat #'upcase '("a" "b" "c") 'string)) | ||
| 1148 | (seq-doseq | ||
| 1149 | :no-eval (seq-doseq (a '("foo" "bar")) (insert a)) | ||
| 1150 | :eg-result ("foo" "bar")) | ||
| 1151 | (seq-do | ||
| 1152 | :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar")) | ||
| 1153 | :eg-result ("foo" "bar")) | ||
| 1154 | (seq-do-indexed | ||
| 1155 | :no-eval (seq-do-indexed | ||
| 1156 | (lambda (a index) (message "%s:%s" index a)) | ||
| 1157 | '("foo" "bar")) | ||
| 1158 | :eg-result nil) | ||
| 1159 | (seq-reduce | ||
| 1160 | :eval (seq-reduce #'* [1 2 3] 2)) | ||
| 1161 | "Excerpting Sequences" | ||
| 1162 | (seq-drop | ||
| 1163 | :eval (seq-drop '(a b c) 2)) | ||
| 1164 | (seq-drop-while | ||
| 1165 | :eval (seq-drop-while #'numberp '(1 2 c d 5))) | ||
| 1166 | (seq-filter | ||
| 1167 | :eval (seq-filter #'numberp '(a b 3 4 f 6))) | ||
| 1168 | (seq-keep | ||
| 1169 | :eval (seq-keep #'car-safe '((1 2) 3 t (a . b)))) | ||
| 1170 | (seq-remove | ||
| 1171 | :eval (seq-remove #'numberp '(1 2 c d 5))) | ||
| 1172 | (seq-remove-at-position | ||
| 1173 | :eval (seq-remove-at-position '(a b c d e) 3) | ||
| 1174 | :eval (seq-remove-at-position [a b c d e] 0)) | ||
| 1175 | (seq-group-by | ||
| 1176 | :eval (seq-group-by #'natnump '(-1 2 3 -4 -5 6))) | ||
| 1177 | (seq-union | ||
| 1178 | :eval (seq-union '(1 2 3) '(3 5))) | ||
| 1179 | (seq-difference | ||
| 1180 | :eval (seq-difference '(1 2 3) '(2 3 4))) | ||
| 1181 | (seq-intersection | ||
| 1182 | :eval (seq-intersection '(1 2 3) '(2 3 4))) | ||
| 1183 | (seq-partition | ||
| 1184 | :eval (seq-partition '(a b c d e f g h) 3)) | ||
| 1185 | (seq-subseq | ||
| 1186 | :eval (seq-subseq '(a b c d e) 2 4)) | ||
| 1187 | (seq-take | ||
| 1188 | :eval (seq-take '(a b c d e) 3)) | ||
| 1189 | (seq-split | ||
| 1190 | :eval (seq-split [0 1 2 3 5] 2)) | ||
| 1191 | (seq-take-while | ||
| 1192 | :eval (seq-take-while #'integerp [1 2 3.0 4])) | ||
| 1193 | (seq-uniq | ||
| 1194 | :eval (seq-uniq '(a b d b a c)))) | ||
| 1195 | |||
| 1196 | (define-short-documentation-group buffer | ||
| 1197 | "Buffer Basics" | ||
| 1198 | (current-buffer | ||
| 1199 | :no-eval (current-buffer) | ||
| 1200 | :eg-result-string "#<buffer shortdoc.el>") | ||
| 1201 | (bufferp | ||
| 1202 | :eval (bufferp 23)) | ||
| 1203 | (buffer-live-p | ||
| 1204 | :no-eval (buffer-live-p some-buffer) | ||
| 1205 | :eg-result t) | ||
| 1206 | (buffer-modified-p | ||
| 1207 | :eval (buffer-modified-p (current-buffer))) | ||
| 1208 | (buffer-name | ||
| 1209 | :eval (buffer-name)) | ||
| 1210 | (window-buffer | ||
| 1211 | :eval (window-buffer)) | ||
| 1212 | "Selecting Buffers" | ||
| 1213 | (get-buffer-create | ||
| 1214 | :no-eval (get-buffer-create "*foo*") | ||
| 1215 | :eg-result-string "#<buffer *foo*>") | ||
| 1216 | (pop-to-buffer | ||
| 1217 | :no-eval (pop-to-buffer "*foo*") | ||
| 1218 | :eg-result-string "#<buffer *foo*>") | ||
| 1219 | (with-current-buffer | ||
| 1220 | :no-eval* (with-current-buffer buffer (buffer-size))) | ||
| 1221 | "Points and Positions" | ||
| 1222 | (point | ||
| 1223 | :eval (point)) | ||
| 1224 | (point-min | ||
| 1225 | :eval (point-min)) | ||
| 1226 | (point-max | ||
| 1227 | :eval (point-max)) | ||
| 1228 | (pos-bol | ||
| 1229 | :eval (pos-bol)) | ||
| 1230 | (pos-eol | ||
| 1231 | :eval (pos-eol)) | ||
| 1232 | (bolp | ||
| 1233 | :eval (bolp)) | ||
| 1234 | (eolp | ||
| 1235 | :eval (eolp)) | ||
| 1236 | (line-beginning-position | ||
| 1237 | :eval (line-beginning-position)) | ||
| 1238 | (line-end-position | ||
| 1239 | :eval (line-end-position)) | ||
| 1240 | (buffer-size | ||
| 1241 | :eval (buffer-size)) | ||
| 1242 | (bobp | ||
| 1243 | :eval (bobp)) | ||
| 1244 | (eobp | ||
| 1245 | :eval (eobp)) | ||
| 1246 | "Moving Around" | ||
| 1247 | (goto-char | ||
| 1248 | :no-eval (goto-char (point-max)) | ||
| 1249 | :eg-result 342) | ||
| 1250 | (search-forward | ||
| 1251 | :no-eval (search-forward "some-string" nil t) | ||
| 1252 | :eg-result 245) | ||
| 1253 | (re-search-forward | ||
| 1254 | :no-eval (re-search-forward "some-s.*g" nil t) | ||
| 1255 | :eg-result 245) | ||
| 1256 | (forward-line | ||
| 1257 | :no-eval (forward-line 1) | ||
| 1258 | :eg-result 0 | ||
| 1259 | :no-eval (forward-line -2) | ||
| 1260 | :eg-result 0) | ||
| 1261 | "Strings from Buffers" | ||
| 1262 | (buffer-string | ||
| 1263 | :no-eval* (buffer-string)) | ||
| 1264 | (buffer-substring | ||
| 1265 | :eval (buffer-substring (point-min) (+ (point-min) 10))) | ||
| 1266 | (buffer-substring-no-properties | ||
| 1267 | :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10))) | ||
| 1268 | (following-char | ||
| 1269 | :no-eval (following-char) | ||
| 1270 | :eg-result 67) | ||
| 1271 | (preceding-char | ||
| 1272 | :no-eval (preceding-char) | ||
| 1273 | :eg-result 38) | ||
| 1274 | (char-after | ||
| 1275 | :eval (char-after 45)) | ||
| 1276 | (char-before | ||
| 1277 | :eval (char-before 13)) | ||
| 1278 | (get-byte | ||
| 1279 | :no-eval (get-byte 45) | ||
| 1280 | :eg-result-string "#xff") | ||
| 1281 | "Altering Buffers" | ||
| 1282 | (delete-region | ||
| 1283 | :no-value (delete-region (point-min) (point-max))) | ||
| 1284 | (erase-buffer | ||
| 1285 | :no-value (erase-buffer)) | ||
| 1286 | (delete-line | ||
| 1287 | :no-value (delete-line)) | ||
| 1288 | (insert | ||
| 1289 | :no-value (insert "This string will be inserted in the buffer\n")) | ||
| 1290 | (subst-char-in-region | ||
| 1291 | :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)") | ||
| 1292 | (replace-string-in-region | ||
| 1293 | :no-value (replace-string-in-region "foo" "bar")) | ||
| 1294 | "Locking" | ||
| 1295 | (lock-buffer | ||
| 1296 | :no-value (lock-buffer "/tmp/foo")) | ||
| 1297 | (unlock-buffer | ||
| 1298 | :no-value (unlock-buffer))) | ||
| 1299 | |||
| 1300 | (define-short-documentation-group overlay | ||
| 1301 | "Predicates" | ||
| 1302 | (overlayp | ||
| 1303 | :no-eval (overlayp some-overlay) | ||
| 1304 | :eg-result t) | ||
| 1305 | "Creation and Deletion" | ||
| 1306 | (make-overlay | ||
| 1307 | :args (beg end &optional buffer) | ||
| 1308 | :no-eval (make-overlay 1 10) | ||
| 1309 | :eg-result-string "#<overlay from 1 to 10 in *foo*>") | ||
| 1310 | (delete-overlay | ||
| 1311 | :no-eval (delete-overlay foo) | ||
| 1312 | :eg-result t) | ||
| 1313 | "Searching Overlays" | ||
| 1314 | (overlays-at | ||
| 1315 | :no-eval (overlays-at 15) | ||
| 1316 | :eg-result-string "(#<overlay from 1 to 10 in *foo*>)") | ||
| 1317 | (overlays-in | ||
| 1318 | :no-eval (overlays-in 1 30) | ||
| 1319 | :eg-result-string "(#<overlay from 1 to 10 in *foo*>)") | ||
| 1320 | (next-overlay-change | ||
| 1321 | :no-eval (next-overlay-change 1) | ||
| 1322 | :eg-result 20) | ||
| 1323 | (previous-overlay-change | ||
| 1324 | :no-eval (previous-overlay-change 30) | ||
| 1325 | :eg-result 20) | ||
| 1326 | "Overlay Properties" | ||
| 1327 | (overlay-start | ||
| 1328 | :no-eval (overlay-start foo) | ||
| 1329 | :eg-result 1) | ||
| 1330 | (overlay-end | ||
| 1331 | :no-eval (overlay-end foo) | ||
| 1332 | :eg-result 10) | ||
| 1333 | (overlay-put | ||
| 1334 | :no-eval (overlay-put foo 'happy t) | ||
| 1335 | :eg-result t) | ||
| 1336 | (overlay-get | ||
| 1337 | :no-eval (overlay-get foo 'happy) | ||
| 1338 | :eg-result t) | ||
| 1339 | (overlay-buffer | ||
| 1340 | :no-eval (overlay-buffer foo)) | ||
| 1341 | "Moving Overlays" | ||
| 1342 | (move-overlay | ||
| 1343 | :no-eval (move-overlay foo 5 20) | ||
| 1344 | :eg-result-string "#<overlay from 5 to 20 in *foo*>")) | ||
| 1345 | |||
| 1346 | (define-short-documentation-group process | ||
| 1347 | (make-process | ||
| 1348 | :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo")) | ||
| 1349 | :eg-result-string "#<process foo>") | ||
| 1350 | (processp | ||
| 1351 | :eval (processp t)) | ||
| 1352 | (process-status | ||
| 1353 | :no-eval (process-status process) | ||
| 1354 | :eg-result exit) | ||
| 1355 | (delete-process | ||
| 1356 | :no-value (delete-process process)) | ||
| 1357 | (kill-process | ||
| 1358 | :no-value (kill-process process)) | ||
| 1359 | (set-process-sentinel | ||
| 1360 | :no-value (set-process-sentinel process (lambda (proc string)))) | ||
| 1361 | (process-buffer | ||
| 1362 | :no-eval (process-buffer process) | ||
| 1363 | :eg-result-string "#<buffer *foo*>") | ||
| 1364 | (get-buffer-process | ||
| 1365 | :no-eval (get-buffer-process buffer) | ||
| 1366 | :eg-result-string "#<process foo>") | ||
| 1367 | (process-live-p | ||
| 1368 | :no-eval (process-live-p process) | ||
| 1369 | :eg-result t)) | ||
| 1370 | |||
| 1371 | (define-short-documentation-group number | ||
| 1372 | "Arithmetic" | ||
| 1373 | (+ | ||
| 1374 | :args (&rest numbers) | ||
| 1375 | :eval (+ 1 2) | ||
| 1376 | :eval (+ 1 2 3 4)) | ||
| 1377 | (- | ||
| 1378 | :args (&rest numbers) | ||
| 1379 | :eval (- 3 2) | ||
| 1380 | :eval (- 6 3 2)) | ||
| 1381 | (* | ||
| 1382 | :args (&rest numbers) | ||
| 1383 | :eval (* 3 4 5)) | ||
| 1384 | (/ | ||
| 1385 | :eval (/ 10 5) | ||
| 1386 | :eval (/ 10 6) | ||
| 1387 | :eval (/ 10.0 6) | ||
| 1388 | :eval (/ 10.0 3 3)) | ||
| 1389 | (% | ||
| 1390 | :eval (% 10 5) | ||
| 1391 | :eval (% 10 6)) | ||
| 1392 | (mod | ||
| 1393 | :eval (mod 10 5) | ||
| 1394 | :eval (mod 10 6) | ||
| 1395 | :eval (mod 10.5 6)) | ||
| 1396 | (1+ | ||
| 1397 | :eval (1+ 2) | ||
| 1398 | :eval (let ((x 2)) (1+ x) x)) | ||
| 1399 | (1- | ||
| 1400 | :eval (1- 4) | ||
| 1401 | :eval (let ((x 4)) (1- x) x)) | ||
| 1402 | (incf | ||
| 1403 | :eval (let ((x 2)) (incf x) x) | ||
| 1404 | :eval (let ((x 2)) (incf x 2) x)) | ||
| 1405 | (decf | ||
| 1406 | :eval (let ((x 4)) (decf x) x) | ||
| 1407 | :eval (let ((x 4)) (decf x 2)) x) | ||
| 1408 | "Predicates" | ||
| 1409 | (= | ||
| 1410 | :args (number &rest numbers) | ||
| 1411 | :eval (= 4 4) | ||
| 1412 | :eval (= 4.0 4.0) | ||
| 1413 | :eval (= 4 4.0) | ||
| 1414 | :eval (= 4 4 4 4)) | ||
| 1415 | (eql | ||
| 1416 | :eval (eql 4 4) | ||
| 1417 | :eval (eql 4.0 4.0)) | ||
| 1418 | (/= | ||
| 1419 | :eval (/= 4 4)) | ||
| 1420 | (< | ||
| 1421 | :args (number &rest numbers) | ||
| 1422 | :eval (< 4 4) | ||
| 1423 | :eval (< 1 2 3)) | ||
| 1424 | (<= | ||
| 1425 | :args (number &rest numbers) | ||
| 1426 | :eval (<= 4 4) | ||
| 1427 | :eval (<= 1 2 2 3)) | ||
| 1428 | (> | ||
| 1429 | :args (number &rest numbers) | ||
| 1430 | :eval (> 4 4) | ||
| 1431 | :eval (> 3 2 1)) | ||
| 1432 | (>= | ||
| 1433 | :args (number &rest numbers) | ||
| 1434 | :eval (>= 4 4) | ||
| 1435 | :eval (>= 3 2 2 1)) | ||
| 1436 | (zerop | ||
| 1437 | :eval (zerop 0)) | ||
| 1438 | (natnump | ||
| 1439 | :eval (natnump -1) | ||
| 1440 | :eval (natnump 0) | ||
| 1441 | :eval (natnump 23)) | ||
| 1442 | (plusp | ||
| 1443 | :eval (plusp 0) | ||
| 1444 | :eval (plusp 1)) | ||
| 1445 | (minusp | ||
| 1446 | :eval (minusp 0) | ||
| 1447 | :eval (minusp -1)) | ||
| 1448 | (oddp | ||
| 1449 | :eval (oddp 3)) | ||
| 1450 | (evenp | ||
| 1451 | :eval (evenp 6)) | ||
| 1452 | (bignump | ||
| 1453 | :eval (bignump 4) | ||
| 1454 | :eval (bignump (expt 2 90))) | ||
| 1455 | (fixnump | ||
| 1456 | :eval (fixnump 4) | ||
| 1457 | :eval (fixnump (expt 2 90))) | ||
| 1458 | (floatp | ||
| 1459 | :eval (floatp 5.4)) | ||
| 1460 | (integerp | ||
| 1461 | :eval (integerp 5.4)) | ||
| 1462 | (numberp | ||
| 1463 | :eval (numberp "5.4")) | ||
| 1464 | (cl-digit-char-p | ||
| 1465 | :eval (cl-digit-char-p ?5 10) | ||
| 1466 | :eval (cl-digit-char-p ?f 16)) | ||
| 1467 | "Operations" | ||
| 1468 | (max | ||
| 1469 | :args (number &rest numbers) | ||
| 1470 | :eval (max 7 9 3)) | ||
| 1471 | (min | ||
| 1472 | :args (number &rest numbers) | ||
| 1473 | :eval (min 7 9 3)) | ||
| 1474 | (abs | ||
| 1475 | :eval (abs -4)) | ||
| 1476 | (float | ||
| 1477 | :eval (float 2)) | ||
| 1478 | (truncate | ||
| 1479 | :eval (truncate 1.2) | ||
| 1480 | :eval (truncate -1.2) | ||
| 1481 | :eval (truncate 5.4 2)) | ||
| 1482 | (floor | ||
| 1483 | :eval (floor 1.2) | ||
| 1484 | :eval (floor -1.2) | ||
| 1485 | :eval (floor 5.4 2)) | ||
| 1486 | (ceiling | ||
| 1487 | :eval (ceiling 1.2) | ||
| 1488 | :eval (ceiling -1.2) | ||
| 1489 | :eval (ceiling 5.4 2)) | ||
| 1490 | (round | ||
| 1491 | :eval (round 1.2) | ||
| 1492 | :eval (round -1.2) | ||
| 1493 | :eval (round 5.4 2)) | ||
| 1494 | (random | ||
| 1495 | :eval (random 6)) | ||
| 1496 | "Bit Operations" | ||
| 1497 | (ash | ||
| 1498 | :eval (ash 1 4) | ||
| 1499 | :eval (ash 16 -1)) | ||
| 1500 | (logand | ||
| 1501 | :no-eval "(logand #b10 #b111)" | ||
| 1502 | :result-string "#b10") | ||
| 1503 | (logior | ||
| 1504 | :eval (logior 4 16)) | ||
| 1505 | (logxor | ||
| 1506 | :eval (logxor 4 16)) | ||
| 1507 | (lognot | ||
| 1508 | :eval (lognot 5)) | ||
| 1509 | (logcount | ||
| 1510 | :eval (logcount 5)) | ||
| 1511 | "Floating Point" | ||
| 1512 | (isnan | ||
| 1513 | :eval (isnan 5.0)) | ||
| 1514 | (frexp | ||
| 1515 | :eval (frexp 5.7)) | ||
| 1516 | (ldexp | ||
| 1517 | :eval (ldexp 0.7125 3)) | ||
| 1518 | (logb | ||
| 1519 | :eval (logb 10.5)) | ||
| 1520 | (ffloor | ||
| 1521 | :eval (ffloor 1.2)) | ||
| 1522 | (fceiling | ||
| 1523 | :eval (fceiling 1.2)) | ||
| 1524 | (ftruncate | ||
| 1525 | :eval (ftruncate 1.2)) | ||
| 1526 | (fround | ||
| 1527 | :eval (fround 1.2)) | ||
| 1528 | "Standard Math Functions" | ||
| 1529 | (sin | ||
| 1530 | :eval (sin float-pi)) | ||
| 1531 | (cos | ||
| 1532 | :eval (cos float-pi)) | ||
| 1533 | (tan | ||
| 1534 | :eval (tan float-pi)) | ||
| 1535 | (asin | ||
| 1536 | :eval (asin float-pi)) | ||
| 1537 | (acos | ||
| 1538 | :eval (acos float-pi)) | ||
| 1539 | (atan | ||
| 1540 | :eval (atan float-pi)) | ||
| 1541 | (exp | ||
| 1542 | :eval (exp 4)) | ||
| 1543 | (log | ||
| 1544 | :eval (log 54.59)) | ||
| 1545 | (expt | ||
| 1546 | :eval (expt 2 16)) | ||
| 1547 | (sqrt | ||
| 1548 | :eval (sqrt -1))) | ||
| 1549 | |||
| 1550 | (define-short-documentation-group text-properties | ||
| 1551 | "Examining Text Properties" | ||
| 1552 | (get-text-property | ||
| 1553 | :eval (get-text-property 0 'foo (propertize "x" 'foo t))) | ||
| 1554 | (get-char-property | ||
| 1555 | :eval (get-char-property 0 'foo (propertize "x" 'foo t))) | ||
| 1556 | (get-pos-property | ||
| 1557 | :eval (get-pos-property 0 'foo (propertize "x" 'foo t))) | ||
| 1558 | (get-char-property-and-overlay | ||
| 1559 | :eval (get-char-property-and-overlay 0 'foo (propertize "x" 'foo t))) | ||
| 1560 | (text-properties-at | ||
| 1561 | :eval (text-properties-at (point))) | ||
| 1562 | "Changing Text Properties" | ||
| 1563 | (put-text-property | ||
| 1564 | :eval (let ((s (copy-sequence "abc"))) (put-text-property 0 1 'foo t s) s) | ||
| 1565 | :no-eval (put-text-property (point) (1+ (point)) 'face 'error)) | ||
| 1566 | (add-text-properties | ||
| 1567 | :no-eval (add-text-properties (point) (1+ (point)) '(face error))) | ||
| 1568 | (remove-text-properties | ||
| 1569 | :no-eval (remove-text-properties (point) (1+ (point)) '(face nil))) | ||
| 1570 | (remove-list-of-text-properties | ||
| 1571 | :no-eval (remove-list-of-text-properties (point) (1+ (point)) '(face font-lock-face))) | ||
| 1572 | (set-text-properties | ||
| 1573 | :no-eval (set-text-properties (point) (1+ (point)) '(face error))) | ||
| 1574 | (add-face-text-property | ||
| 1575 | :no-eval (add-face-text-property START END '(:foreground "green"))) | ||
| 1576 | (propertize | ||
| 1577 | :eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic)) | ||
| 1578 | "Searching for Text Properties" | ||
| 1579 | (next-property-change | ||
| 1580 | :no-eval (next-property-change (point) (current-buffer))) | ||
| 1581 | (previous-property-change | ||
| 1582 | :no-eval (previous-property-change (point) (current-buffer))) | ||
| 1583 | (next-single-property-change | ||
| 1584 | :no-eval (next-single-property-change (point) 'face (current-buffer))) | ||
| 1585 | (previous-single-property-change | ||
| 1586 | :no-eval (previous-single-property-change (point) 'face (current-buffer))) | ||
| 1587 | ;; TODO: There are some more that could be added here. | ||
| 1588 | (text-property-search-forward | ||
| 1589 | :no-eval (text-property-search-forward 'face nil t)) | ||
| 1590 | (text-property-search-backward | ||
| 1591 | :no-eval (text-property-search-backward 'face nil t))) | ||
| 1592 | |||
| 1593 | (define-short-documentation-group keymaps | ||
| 1594 | "Defining keymaps or adding bindings to existing keymaps" | ||
| 1595 | (define-keymap | ||
| 1596 | :no-eval (define-keymap "C-c C-c" #'quit-buffer) | ||
| 1597 | :no-eval (define-keymap :keymap ctl-x-map | ||
| 1598 | "C-r" #'recentf-open | ||
| 1599 | "k" #'kill-current-buffer)) | ||
| 1600 | (defvar-keymap | ||
| 1601 | :no-eval (defvar-keymap my-keymap "C-c C-c" #'quit-buffer)) | ||
| 1602 | "Setting keys" | ||
| 1603 | (keymap-set | ||
| 1604 | :no-eval (keymap-set map "C-c C-c" #'quit-buffer)) | ||
| 1605 | (keymap-local-set | ||
| 1606 | :no-eval (keymap-local-set "C-c C-c" #'quit-buffer)) | ||
| 1607 | (keymap-global-set | ||
| 1608 | :no-eval (keymap-global-set "C-c C-c" #'quit-buffer)) | ||
| 1609 | (keymap-unset | ||
| 1610 | :no-eval (keymap-unset map "C-c C-c")) | ||
| 1611 | (keymap-local-unset | ||
| 1612 | :no-eval (keymap-local-unset "C-c C-c")) | ||
| 1613 | (keymap-global-unset | ||
| 1614 | :no-eval (keymap-global-unset "C-c C-c")) | ||
| 1615 | (keymap-substitute | ||
| 1616 | :no-eval (keymap-substitute map "C-c C-c" "M-a")) | ||
| 1617 | (keymap-set-after | ||
| 1618 | :no-eval (keymap-set-after map "<separator-2>" menu-bar-separator)) | ||
| 1619 | "Predicates" | ||
| 1620 | (keymapp | ||
| 1621 | :eval (keymapp (define-keymap))) | ||
| 1622 | (key-valid-p | ||
| 1623 | :eval (key-valid-p "C-c C-c") | ||
| 1624 | :eval (key-valid-p "C-cC-c")) | ||
| 1625 | "Lookup" | ||
| 1626 | (keymap-lookup | ||
| 1627 | :eval (keymap-lookup (current-global-map) "C-x x g"))) | ||
| 1628 | |||
| 1629 | ;;;###autoload | 239 | ;;;###autoload |
| 1630 | (defun shortdoc-display-group (group &optional function same-window) | 240 | (defun shortdoc-display-group (group &optional function same-window) |
| 1631 | "Pop to a buffer with short documentation summary for functions in GROUP. | 241 | "Pop to a buffer with short documentation summary for functions in GROUP. |
| @@ -1650,6 +260,9 @@ If SAME-WINDOW, don't pop to a new window." | |||
| 1650 | (text-property-search-forward 'shortdoc-function function t) | 260 | (text-property-search-forward 'shortdoc-function function t) |
| 1651 | (beginning-of-line))) | 261 | (beginning-of-line))) |
| 1652 | 262 | ||
| 263 | ;;;###autoload | ||
| 264 | (defalias 'shortdoc #'shortdoc-display-group) | ||
| 265 | |||
| 1653 | (defun shortdoc--insert-group-in-buffer (group &optional buf) | 266 | (defun shortdoc--insert-group-in-buffer (group &optional buf) |
| 1654 | "Insert a short documentation summary for functions in GROUP in buffer BUF. | 267 | "Insert a short documentation summary for functions in GROUP in buffer BUF. |
| 1655 | BUF defaults to the current buffer if nil or omitted." | 268 | BUF defaults to the current buffer if nil or omitted." |
| @@ -1685,9 +298,6 @@ BUF defaults to the current buffer if nil or omitted." | |||
| 1685 | (shortdoc--display-function data)))) | 298 | (shortdoc--display-function data)))) |
| 1686 | (cdr (assq group shortdoc--groups)))))) | 299 | (cdr (assq group shortdoc--groups)))))) |
| 1687 | 300 | ||
| 1688 | ;;;###autoload | ||
| 1689 | (defalias 'shortdoc #'shortdoc-display-group) | ||
| 1690 | |||
| 1691 | (defun shortdoc--display-function (data) | 301 | (defun shortdoc--display-function (data) |
| 1692 | (let ((function (pop data)) | 302 | (let ((function (pop data)) |
| 1693 | (start-section (point)) | 303 | (start-section (point)) |
| @@ -1875,6 +485,10 @@ Example: | |||
| 1875 | (shortdoc-add-function | 485 | (shortdoc-add-function |
| 1876 | \\='file \"Predicates\" | 486 | \\='file \"Predicates\" |
| 1877 | \\='(file-locked-p :no-eval (file-locked-p \"/tmp\")))" | 487 | \\='(file-locked-p :no-eval (file-locked-p \"/tmp\")))" |
| 488 | ;; Rely on `shortdoc--check' checking GROUP. | ||
| 489 | (unless (stringp section) | ||
| 490 | (signal 'wrong-type-argument (list 'stringp section))) | ||
| 491 | (shortdoc--check group (list section elem)) | ||
| 1878 | (let ((glist (assq group shortdoc--groups))) | 492 | (let ((glist (assq group shortdoc--groups))) |
| 1879 | (unless glist | 493 | (unless glist |
| 1880 | (setq glist (list group)) | 494 | (setq glist (list group)) |
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index ddf3b594e12..7db316acda7 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el | |||
| @@ -372,6 +372,7 @@ entirely by setting `warning-suppress-types' or | |||
| 372 | (if (bolp) | 372 | (if (bolp) |
| 373 | (forward-char -1)) | 373 | (forward-char -1)) |
| 374 | (message "%s" (buffer-substring start (point)))))) | 374 | (message "%s" (buffer-substring start (point)))))) |
| 375 | ;; Use `frame-initial-p'? | ||
| 375 | ((and (daemonp) (eq (selected-frame) terminal-frame)) | 376 | ((and (daemonp) (eq (selected-frame) terminal-frame)) |
| 376 | ;; Display daemon startup warnings on the first client frame. | 377 | ;; Display daemon startup warnings on the first client frame. |
| 377 | (letrec ((afterfun | 378 | (letrec ((afterfun |
diff --git a/lisp/epa-file.el b/lisp/epa-file.el index b2a89907867..95202851544 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el | |||
| @@ -232,7 +232,22 @@ encryption is used." | |||
| 232 | (epa-file-decode-and-insert | 232 | (epa-file-decode-and-insert |
| 233 | string file visit beg end replace)))) | 233 | string file visit beg end replace)))) |
| 234 | (if visit | 234 | (if visit |
| 235 | (set-visited-file-modtime)))) | 235 | (set-visited-file-modtime))) |
| 236 | ;; The decoded file could still need another massage from a | ||
| 237 | ;; file name handler, for example a file like | ||
| 238 | ;; "folder.sym.tar.gz.gpg". (Bug#80641) | ||
| 239 | (when (find-file-name-handler | ||
| 240 | (file-name-sans-extension file) | ||
| 241 | 'insert-file-contents) | ||
| 242 | (let ((tmpfile | ||
| 243 | (make-temp-file | ||
| 244 | nil nil | ||
| 245 | (file-name-extension (file-name-base file) 'period)))) | ||
| 246 | (let (file-name-handler-alist) (write-region nil nil tmpfile)) | ||
| 247 | (erase-buffer) | ||
| 248 | (insert-file-contents tmpfile) | ||
| 249 | (setq length (- (point-max) (point-min))) | ||
| 250 | (delete-file tmpfile)))) | ||
| 236 | (if (and local-copy | 251 | (if (and local-copy |
| 237 | (file-exists-p local-copy)) | 252 | (file-exists-p local-copy)) |
| 238 | (delete-file local-copy))) | 253 | (delete-file local-copy))) |
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index f5ea63ae764..6306df3fa2a 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el | |||
| @@ -1006,7 +1006,7 @@ Failing that, choose the first face in both NEW-FACES and NORMALS." | |||
| 1006 | (dolist (candidate (cdr ranks)) | 1006 | (dolist (candidate (cdr ranks)) |
| 1007 | (when (and (not (equal candidate choice)) | 1007 | (when (and (not (equal candidate choice)) |
| 1008 | (gethash candidate (car new-faces)) | 1008 | (gethash candidate (car new-faces)) |
| 1009 | (gethash choice normals)) | 1009 | (gethash candidate normals)) |
| 1010 | (throw 'face candidate))) | 1010 | (throw 'face candidate))) |
| 1011 | ;; Otherwise, go with any "normal" face other than | 1011 | ;; Otherwise, go with any "normal" face other than |
| 1012 | ;; `choice' in the region. | 1012 | ;; `choice' in the region. |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 572b73188e3..6facb7966b0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -1693,11 +1693,18 @@ time `erc-mode-hook' runs for any connection." | |||
| 1693 | (declare (indent 1)) | 1693 | (declare (indent 1)) |
| 1694 | (cl-assert (stringp (car args))) | 1694 | (cl-assert (stringp (car args))) |
| 1695 | (if (derived-mode-p 'erc-mode) | 1695 | (if (derived-mode-p 'erc-mode) |
| 1696 | (unless (or (erc-with-server-buffer ; needs `erc-server-process' | 1696 | (unless |
| 1697 | (apply #'erc-button--display-error-notice-with-keys | 1697 | (or (erc-with-server-buffer ; needs `erc-server-process' |
| 1698 | (current-buffer) args) | 1698 | (let ((fn |
| 1699 | t) | 1699 | (lambda (buffer) |
| 1700 | erc--target) ; unlikely | 1700 | (erc-with-buffer (buffer) |
| 1701 | (apply #'erc-button--display-error-notice-with-keys | ||
| 1702 | buffer args))))) | ||
| 1703 | (if erc--msg-props | ||
| 1704 | (run-at-time nil nil fn (current-buffer)) | ||
| 1705 | (funcall fn (current-buffer)))) | ||
| 1706 | t) | ||
| 1707 | erc--target) ; unlikely | ||
| 1701 | (let (hook) | 1708 | (let (hook) |
| 1702 | (setq hook | 1709 | (setq hook |
| 1703 | (lambda (_) | 1710 | (lambda (_) |
diff --git a/lisp/files.el b/lisp/files.el index f9af75187cb..e05a4b99497 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -1790,7 +1790,10 @@ If DIR-FLAG is non-nil, create a new empty directory instead of a file. | |||
| 1790 | If SUFFIX is non-nil, add that at the end of the file name. | 1790 | If SUFFIX is non-nil, add that at the end of the file name. |
| 1791 | 1791 | ||
| 1792 | If TEXT is a string, insert it into the new file; DIR-FLAG should be nil. | 1792 | If TEXT is a string, insert it into the new file; DIR-FLAG should be nil. |
| 1793 | Otherwise the file will be empty." | 1793 | Otherwise the file will be empty. |
| 1794 | |||
| 1795 | On Posix systems, the file/directory is created with access mode bits | ||
| 1796 | that limit access to the current user." | ||
| 1794 | (let ((absolute-prefix | 1797 | (let ((absolute-prefix |
| 1795 | (if (or (zerop (length prefix)) (member prefix '("." ".."))) | 1798 | (if (or (zerop (length prefix)) (member prefix '("." ".."))) |
| 1796 | (concat (file-name-as-directory temporary-file-directory) prefix) | 1799 | (concat (file-name-as-directory temporary-file-directory) prefix) |
| @@ -8320,41 +8323,24 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'." | |||
| 8320 | (forward-line -1)) | 8323 | (forward-line -1)) |
| 8321 | (if (let ((case-fold-search nil)) (looking-at "//DIRED//")) | 8324 | (if (let ((case-fold-search nil)) (looking-at "//DIRED//")) |
| 8322 | (let ((end (line-end-position)) | 8325 | (let ((end (line-end-position)) |
| 8323 | (linebeg (point)) | 8326 | (linebeg (point))) |
| 8324 | error-lines) | 8327 | ;; Read the numeric positions of file names. |
| 8325 | ;; Find all the lines that are error messages, | ||
| 8326 | ;; and record the bounds of each one. | ||
| 8327 | (goto-char beg) | ||
| 8328 | (while (< (point) linebeg) | ||
| 8329 | (or (eql (following-char) ?\s) | ||
| 8330 | (push (list (point) (line-end-position)) error-lines)) | ||
| 8331 | (forward-line 1)) | ||
| 8332 | (setq error-lines (nreverse error-lines)) | ||
| 8333 | ;; Now read the numeric positions of file names. | ||
| 8334 | (goto-char linebeg) | 8328 | (goto-char linebeg) |
| 8335 | (forward-word-strictly 1) | 8329 | (forward-word-strictly 1) |
| 8336 | (forward-char 3) | 8330 | (forward-char 3) |
| 8337 | (while (< (point) end) | 8331 | (while (< (point) end) |
| 8338 | (let ((start (insert-directory-adj-pos | 8332 | (let ((start (+ beg (read (current-buffer)))) |
| 8339 | (+ beg (read (current-buffer))) | 8333 | (end (+ beg (read (current-buffer))))) |
| 8340 | error-lines)) | 8334 | (when (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|)) |
| 8341 | (end (insert-directory-adj-pos | 8335 | ;; End is followed by \n or by output of -F. |
| 8342 | (+ beg (read (current-buffer))) | 8336 | (put-text-property start end 'dired-filename t)))) |
| 8343 | error-lines))) | ||
| 8344 | (if (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|)) | ||
| 8345 | ;; End is followed by \n or by output of -F. | ||
| 8346 | (put-text-property start end 'dired-filename t) | ||
| 8347 | ;; It seems that we can't trust ls's output as to | ||
| 8348 | ;; byte positions of filenames. | ||
| 8349 | (put-text-property beg (point) 'dired-filename nil) | ||
| 8350 | (end-of-line)))) | ||
| 8351 | (goto-char end) | 8337 | (goto-char end) |
| 8352 | (beginning-of-line) | 8338 | (beginning-of-line) |
| 8353 | (delete-region (point) (progn (forward-line 1) (point)))) | 8339 | (delete-region (point) (progn (forward-line 1) (point)))) |
| 8354 | ;; Take care of the case where the ls output contains a | 8340 | ;; Take care of the case where the ls output contains a |
| 8355 | ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line | 8341 | ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line |
| 8356 | ;; and we went one line too far back (see above). | 8342 | ;; and we went one line too far back (see above). |
| 8357 | (forward-line 1)) | 8343 | (unless (bobp) (forward-line 1))) |
| 8358 | (if (let ((case-fold-search nil)) (looking-at "//DIRED-OPTIONS//")) | 8344 | (if (let ((case-fold-search nil)) (looking-at "//DIRED-OPTIONS//")) |
| 8359 | (delete-region (point) (progn (forward-line 1) (point)))))) | 8345 | (delete-region (point) (progn (forward-line 1) (point)))))) |
| 8360 | 8346 | ||
| @@ -8363,12 +8349,12 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'." | |||
| 8363 | ;; FULL-DIRECTORY-P is nil. | 8349 | ;; FULL-DIRECTORY-P is nil. |
| 8364 | ;; The single line of output must display FILE's name as it was | 8350 | ;; The single line of output must display FILE's name as it was |
| 8365 | ;; given, namely, an absolute path name. | 8351 | ;; given, namely, an absolute path name. |
| 8366 | ;; - must insert exactly one line for each file if WILDCARD or | 8352 | ;; - must insert exactly one entry for each file if WILDCARD or |
| 8367 | ;; FULL-DIRECTORY-P is t, plus one optional "total" line | 8353 | ;; FULL-DIRECTORY-P is t, plus one optional "total" line |
| 8368 | ;; before the file lines, plus optional text after the file lines. | 8354 | ;; before the file lines, plus optional text after the file lines. |
| 8369 | ;; Lines are delimited by "\n", so filenames containing "\n" are not | 8355 | ;; Entries are delimited by "\n", but file names containing "\n" are |
| 8370 | ;; allowed. | 8356 | ;; allowed and by default the "\n" is displayed as a literal newline. |
| 8371 | ;; File lines should display the basename. | 8357 | ;; File entries should display the basename. |
| 8372 | ;; - must be consistent with | 8358 | ;; - must be consistent with |
| 8373 | ;; - functions dired-move-to-filename, (these two define what a file line is) | 8359 | ;; - functions dired-move-to-filename, (these two define what a file line is) |
| 8374 | ;; dired-move-to-end-of-filename, | 8360 | ;; dired-move-to-end-of-filename, |
| @@ -8410,10 +8396,10 @@ normally equivalent short `-D' option is just passed on to | |||
| 8410 | (declare-function ls-lisp--insert-directory "ls-lisp") | 8396 | (declare-function ls-lisp--insert-directory "ls-lisp") |
| 8411 | (ls-lisp--insert-directory file switches wildcard full-directory-p)) | 8397 | (ls-lisp--insert-directory file switches wildcard full-directory-p)) |
| 8412 | (t | 8398 | (t |
| 8413 | (let (result (beg (point))) | 8399 | (let ((beg (point)) |
| 8400 | (errfile (make-temp-file "lserr"))) | ||
| 8414 | 8401 | ||
| 8415 | ;; Read the actual directory using `insert-directory-program'. | 8402 | ;; Read the actual directory using `insert-directory-program'. |
| 8416 | ;; RESULT gets the status code. | ||
| 8417 | (let* (;; We at first read by no-conversion, then after | 8403 | (let* (;; We at first read by no-conversion, then after |
| 8418 | ;; putting text property `dired-filename, decode one | 8404 | ;; putting text property `dired-filename, decode one |
| 8419 | ;; bunch by one to preserve that property. | 8405 | ;; bunch by one to preserve that property. |
| @@ -8423,143 +8409,88 @@ normally equivalent short `-D' option is just passed on to | |||
| 8423 | (and enable-multibyte-characters | 8409 | (and enable-multibyte-characters |
| 8424 | (or file-name-coding-system | 8410 | (or file-name-coding-system |
| 8425 | default-file-name-coding-system)))) | 8411 | default-file-name-coding-system)))) |
| 8426 | (setq result | 8412 | (if wildcard |
| 8427 | (if wildcard | 8413 | ;; If the wildcard is just in the file part, then run ls in |
| 8428 | ;; If the wildcard is just in the file part, then run ls in | 8414 | ;; the directory part of the file pattern using the last |
| 8429 | ;; the directory part of the file pattern using the last | 8415 | ;; component as argument. Otherwise, run ls in the longest |
| 8430 | ;; component as argument. Otherwise, run ls in the longest | 8416 | ;; subdirectory of the directory part free of wildcards; use |
| 8431 | ;; subdirectory of the directory part free of wildcards; use | 8417 | ;; the remaining of the file pattern as argument. |
| 8432 | ;; the remaining of the file pattern as argument. | 8418 | (let* ((dir-wildcard |
| 8433 | (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file)) | 8419 | (insert-directory-wildcard-in-dir-p file)) |
| 8434 | (default-directory | 8420 | (default-directory |
| 8435 | (cond (dir-wildcard (car dir-wildcard)) | 8421 | (cond (dir-wildcard (car dir-wildcard)) |
| 8436 | (t | 8422 | (t |
| 8437 | (if (file-name-absolute-p file) | 8423 | (if (file-name-absolute-p file) |
| 8438 | (file-name-directory file) | 8424 | (file-name-directory file) |
| 8439 | (file-name-directory (expand-file-name file)))))) | 8425 | (file-name-directory |
| 8440 | (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file)))) | 8426 | (expand-file-name file)))))) |
| 8441 | ;; NB since switches is passed to the shell, be | 8427 | (pattern (if dir-wildcard |
| 8442 | ;; careful of malicious values, eg "-l;reboot". | 8428 | (cdr dir-wildcard) |
| 8443 | ;; See eg dired-safe-switches-p. | 8429 | (file-name-nondirectory file)))) |
| 8444 | (call-process | 8430 | ;; NB since switches is passed to the shell, be |
| 8445 | shell-file-name nil t nil | 8431 | ;; careful of malicious values, eg "-l;reboot". |
| 8446 | shell-command-switch | 8432 | ;; See eg dired-safe-switches-p. |
| 8447 | (concat (if (memq system-type '(ms-dos windows-nt)) | 8433 | (call-process |
| 8448 | "" | 8434 | shell-file-name nil (list t errfile) nil |
| 8449 | "\\") ; Disregard Unix shell aliases! | 8435 | shell-command-switch |
| 8450 | insert-directory-program | 8436 | (concat (if (memq system-type '(ms-dos windows-nt)) |
| 8451 | " -d " | 8437 | "" |
| 8452 | ;; Quote switches that require quoting | 8438 | "\\") ; Disregard Unix shell aliases! |
| 8453 | ;; such as "--block-size='1". But don't | 8439 | insert-directory-program |
| 8454 | ;; quote switches that use patterns | 8440 | " -d " |
| 8455 | ;; such as "--ignore=PATTERN" (bug#71935). | 8441 | ;; Quote switches that require quoting |
| 8456 | (mapconcat #'shell-quote-wildcard-pattern | 8442 | ;; such as "--block-size='1". But don't |
| 8457 | (if (stringp switches) | 8443 | ;; quote switches that use patterns |
| 8458 | (split-string-and-unquote switches) | 8444 | ;; such as "--ignore=PATTERN" (bug#71935). |
| 8459 | switches) | 8445 | (mapconcat #'shell-quote-wildcard-pattern |
| 8460 | " ") | 8446 | (if (stringp switches) |
| 8461 | " -- " | 8447 | (split-string-and-unquote switches) |
| 8462 | ;; Quote some characters that have | 8448 | switches) |
| 8463 | ;; special meanings in shells; but | 8449 | " ") |
| 8464 | ;; don't quote the wildcards--we want | 8450 | " -- " |
| 8465 | ;; them to be special. We also | 8451 | ;; Quote some characters that have |
| 8466 | ;; currently don't quote the quoting | 8452 | ;; special meanings in shells; but |
| 8467 | ;; characters in case people want to | 8453 | ;; don't quote the wildcards--we want |
| 8468 | ;; use them explicitly to quote | 8454 | ;; them to be special. We also |
| 8469 | ;; wildcard characters. | 8455 | ;; currently don't quote the quoting |
| 8470 | (shell-quote-wildcard-pattern pattern)))) | 8456 | ;; characters in case people want to |
| 8471 | ;; SunOS 4.1.3, SVr4 and others need the "." to list the | 8457 | ;; use them explicitly to quote |
| 8472 | ;; directory if FILE is a symbolic link. | 8458 | ;; wildcard characters. |
| 8473 | (unless full-directory-p | 8459 | (shell-quote-wildcard-pattern pattern)))) |
| 8474 | (setq switches | 8460 | ;; SunOS 4.1.3, SVr4 and others need the "." to list the |
| 8475 | (cond | 8461 | ;; directory if FILE is a symbolic link. |
| 8476 | ((stringp switches) (concat switches " -d")) | 8462 | (unless full-directory-p |
| 8477 | ((member "-d" switches) switches) | 8463 | (setq switches |
| 8478 | (t (append switches '("-d")))))) | 8464 | (cond |
| 8479 | (if (string-match "\\`~" file) | 8465 | ((stringp switches) (concat switches " -d")) |
| 8480 | (setq file (expand-file-name file))) | 8466 | ((member "-d" switches) switches) |
| 8481 | (apply #'call-process | 8467 | (t (append switches '("-d")))))) |
| 8482 | insert-directory-program nil t nil | 8468 | (if (string-match "\\`~" file) |
| 8483 | (append | 8469 | (setq file (expand-file-name file))) |
| 8484 | (if (listp switches) switches | 8470 | (apply #'call-process |
| 8485 | (unless (equal switches "") | 8471 | insert-directory-program nil (list t errfile) nil |
| 8486 | ;; Split the switches at any spaces so we can | 8472 | (append |
| 8487 | ;; pass separate options as separate args. | 8473 | (if (listp switches) switches |
| 8488 | (split-string-and-unquote switches))) | 8474 | (unless (equal switches "") |
| 8489 | ;; Avoid lossage if FILE starts with `-'. | 8475 | ;; Split the switches at any spaces so we can |
| 8490 | '("--") | 8476 | ;; pass separate options as separate args. |
| 8491 | (list file)))))) | 8477 | (split-string-and-unquote switches))) |
| 8492 | 8478 | ;; Avoid lossage if FILE starts with `-'. | |
| 8493 | ;; If we got "//DIRED//" in the output, it means we got a real | 8479 | '("--") |
| 8494 | ;; directory listing, even if `ls' returned nonzero. | 8480 | (list file))))) |
| 8495 | ;; So ignore any errors. | 8481 | |
| 8496 | (when (if (stringp switches) | 8482 | ;; If `ls' emits an error message, copy it to a buffer that will |
| 8497 | (string-match "--dired\\>" switches) | 8483 | ;; be displayed when a Dired invocation results in the `ls' |
| 8498 | (member "--dired" switches)) | 8484 | ;; error. |
| 8499 | (save-excursion | 8485 | (when (> (file-attribute-size (file-attributes errfile)) 0) |
| 8500 | (let ((case-fold-search nil)) | 8486 | (defvar dired--ls-error-buffer) ; Pacify byte-compiler. |
| 8501 | (forward-line -2) | 8487 | (let ((errbuf (get-buffer-create "*ls error*"))) |
| 8502 | (when (looking-at "//SUBDIRED//") | 8488 | (with-current-buffer errbuf |
| 8503 | (forward-line -1)) | 8489 | (erase-buffer) |
| 8504 | (if (looking-at "//DIRED//") | 8490 | (insert-file-contents errfile)) |
| 8505 | (setq result 0))))) | 8491 | (setq dired--ls-error-buffer errbuf))) |
| 8506 | 8492 | (delete-file errfile) | |
| 8507 | (when (and (not (eq 0 result)) | 8493 | |
| 8508 | (eq insert-directory-ls-version 'unknown)) | ||
| 8509 | ;; The first time ls returns an error, | ||
| 8510 | ;; find the version numbers of ls, | ||
| 8511 | ;; and set insert-directory-ls-version | ||
| 8512 | ;; to > if it is more than 5.2.1, < if it is less, nil if it | ||
| 8513 | ;; is equal or if the info cannot be obtained. | ||
| 8514 | ;; (That can mean it isn't GNU ls.) | ||
| 8515 | (let ((version-out | ||
| 8516 | (with-temp-buffer | ||
| 8517 | (call-process "ls" nil t nil "--version") | ||
| 8518 | (buffer-string)))) | ||
| 8519 | (setq insert-directory-ls-version | ||
| 8520 | (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) | ||
| 8521 | (let* ((version (match-string 1 version-out)) | ||
| 8522 | (split (split-string version "[.]")) | ||
| 8523 | (numbers (mapcar #'string-to-number split)) | ||
| 8524 | (min '(5 2 1)) | ||
| 8525 | comparison) | ||
| 8526 | (while (and (not comparison) (or numbers min)) | ||
| 8527 | (cond ((null min) | ||
| 8528 | (setq comparison #'>)) | ||
| 8529 | ((null numbers) | ||
| 8530 | (setq comparison #'<)) | ||
| 8531 | ((> (car numbers) (car min)) | ||
| 8532 | (setq comparison #'>)) | ||
| 8533 | ((< (car numbers) (car min)) | ||
| 8534 | (setq comparison #'<)) | ||
| 8535 | (t | ||
| 8536 | (setq numbers (cdr numbers) | ||
| 8537 | min (cdr min))))) | ||
| 8538 | (or comparison #'=)) | ||
| 8539 | nil)))) | ||
| 8540 | |||
| 8541 | ;; For GNU ls versions 5.2.2 and up, ignore minor errors. | ||
| 8542 | (when (and (eq 1 result) (eq insert-directory-ls-version #'>)) | ||
| 8543 | (setq result 0)) | ||
| 8544 | |||
| 8545 | ;; If `insert-directory-program' failed, signal an error. | ||
| 8546 | (unless (eq 0 result) | ||
| 8547 | ;; Delete the error message it may have output. | ||
| 8548 | (delete-region beg (point)) | ||
| 8549 | ;; On non-Posix systems, we cannot open a directory, so | ||
| 8550 | ;; don't even try, because that will always result in | ||
| 8551 | ;; the ubiquitous "Access denied". Instead, show the | ||
| 8552 | ;; command line so the user can try to guess what went wrong. | ||
| 8553 | (if (and (file-directory-p file) | ||
| 8554 | (memq system-type '(ms-dos windows-nt))) | ||
| 8555 | (error | ||
| 8556 | "Reading directory: \"%s %s -- %s\" exited with status %s" | ||
| 8557 | insert-directory-program | ||
| 8558 | (if (listp switches) (concat switches) switches) | ||
| 8559 | file result) | ||
| 8560 | ;; Unix. Access the file to get a suitable error. | ||
| 8561 | (access-file file "Reading directory") | ||
| 8562 | (error "Listing directory failed but `access-file' worked"))) | ||
| 8563 | (insert-directory-clean beg switches) | 8494 | (insert-directory-clean beg switches) |
| 8564 | ;; Now decode what read if necessary. | 8495 | ;; Now decode what read if necessary. |
| 8565 | (let ((coding (or coding-system-for-read | 8496 | (let ((coding (or coding-system-for-read |
| @@ -8594,18 +8525,6 @@ normally equivalent short `-D' option is just passed on to | |||
| 8594 | (put-text-property pos (point) | 8525 | (put-text-property pos (point) |
| 8595 | 'dired-filename t)))))))))))) | 8526 | 'dired-filename t)))))))))))) |
| 8596 | 8527 | ||
| 8597 | (defun insert-directory-adj-pos (pos error-lines) | ||
| 8598 | "Convert `ls --dired' file name position value POS to a buffer position. | ||
| 8599 | File name position values returned in ls --dired output | ||
| 8600 | count only stdout; they don't count the error messages sent to stderr. | ||
| 8601 | So this function converts to them to real buffer positions. | ||
| 8602 | ERROR-LINES is a list of buffer positions of error message lines, | ||
| 8603 | of the form (START END)." | ||
| 8604 | (while (and error-lines (< (caar error-lines) pos)) | ||
| 8605 | (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines))))) | ||
| 8606 | (pop error-lines)) | ||
| 8607 | pos) | ||
| 8608 | |||
| 8609 | (defun insert-directory-safely (file switches | 8528 | (defun insert-directory-safely (file switches |
| 8610 | &optional wildcard full-directory-p) | 8529 | &optional wildcard full-directory-p) |
| 8611 | "Insert directory listing for FILE, formatted according to SWITCHES. | 8530 | "Insert directory listing for FILE, formatted according to SWITCHES. |
diff --git a/lisp/frame.el b/lisp/frame.el index da48e695297..85b58cee070 100644 --- a/lisp/frame.el +++ b/lisp/frame.el | |||
| @@ -493,6 +493,7 @@ there (in decreasing order of priority)." | |||
| 493 | (setq parms (append initial-frame-alist window-system-frame-alist | 493 | (setq parms (append initial-frame-alist window-system-frame-alist |
| 494 | default-frame-alist parms nil)) | 494 | default-frame-alist parms nil)) |
| 495 | ;; Don't enable tab-bar in daemon's initial frame. | 495 | ;; Don't enable tab-bar in daemon's initial frame. |
| 496 | ;; Use `frame-initial-p'? | ||
| 496 | (when (and (daemonp) (eq (selected-frame) terminal-frame)) | 497 | (when (and (daemonp) (eq (selected-frame) terminal-frame)) |
| 497 | (setq parms (delq (assq 'tab-bar-lines parms) parms))) | 498 | (setq parms (delq (assq 'tab-bar-lines parms) parms))) |
| 498 | parms)) | 499 | parms)) |
diff --git a/lisp/frameset.el b/lisp/frameset.el index e11a1da7e9b..0dde10869fd 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el | |||
| @@ -1370,12 +1370,10 @@ All keyword parameters default to nil." | |||
| 1370 | ;; frame, as that would only trigger | 1370 | ;; frame, as that would only trigger |
| 1371 | ;; warnings. | 1371 | ;; warnings. |
| 1372 | (not | 1372 | (not |
| 1373 | (and (daemonp) | 1373 | (and (daemonp) ;; FIXME: Remove `daemonp'? |
| 1374 | (equal (terminal-name (frame-terminal | 1374 | (frame-initial-p frame)))) |
| 1375 | frame)) | 1375 | (delete-frame frame))) |
| 1376 | "initial_terminal")))) | 1376 | cleanup-frames))) |
| 1377 | (delete-frame frame))) | ||
| 1378 | cleanup-frames))) | ||
| 1379 | (maphash (lambda (frame _action) (push frame map)) frameset--action-map) | 1377 | (maphash (lambda (frame _action) (push frame map)) frameset--action-map) |
| 1380 | (dolist (frame (sort map | 1378 | (dolist (frame (sort map |
| 1381 | ;; Minibufferless frames must go first to avoid | 1379 | ;; Minibufferless frames must go first to avoid |
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index b8fefabacbb..d3088b4001f 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el | |||
| @@ -70,6 +70,9 @@ DELAY is a string, giving the length of the time. Possible values are: | |||
| 70 | * YYYY-MM-DD for a specific date. The time of day is given by the | 70 | * YYYY-MM-DD for a specific date. The time of day is given by the |
| 71 | variable `gnus-delay-default-hour', minute and second are zero. | 71 | variable `gnus-delay-default-hour', minute and second are zero. |
| 72 | 72 | ||
| 73 | * YYYY-MM-DD hh:mm(:ss) for a specific date and time. If seconds are left | ||
| 74 | out, they will be zero. | ||
| 75 | |||
| 73 | * hh:mm for a specific time. Use 24h format. If it is later than this | 76 | * hh:mm for a specific time. Use 24h format. If it is later than this |
| 74 | time, then the deadline is tomorrow, else today. | 77 | time, then the deadline is tomorrow, else today. |
| 75 | 78 | ||
| @@ -82,8 +85,21 @@ generated when the article is sent." | |||
| 82 | message-mode) | 85 | message-mode) |
| 83 | ;; Allow spell checking etc. | 86 | ;; Allow spell checking etc. |
| 84 | (run-hooks 'message-send-hook) | 87 | (run-hooks 'message-send-hook) |
| 85 | (let (num unit year month day hour minute deadline) ;; days | 88 | (let (num unit year month day hour minute deadline second) ;; days |
| 86 | (cond ((string-match | 89 | (cond ((string-match |
| 90 | "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\) \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\):?\\([0-9]\\{2\\}\\)?" | ||
| 91 | delay) | ||
| 92 | (setq year (string-to-number (match-string 1 delay)) | ||
| 93 | month (string-to-number (match-string 2 delay)) | ||
| 94 | day (string-to-number (match-string 3 delay)) | ||
| 95 | hour (string-to-number (match-string 4 delay)) | ||
| 96 | minute (string-to-number (match-string 5 delay)) | ||
| 97 | second (if (match-string 6 delay) (string-to-number (match-string 6 delay)) 0)) | ||
| 98 | (setq deadline | ||
| 99 | (message-make-date | ||
| 100 | (encode-time second minute hour | ||
| 101 | day month year)))) | ||
| 102 | ((string-match | ||
| 87 | "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)" | 103 | "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)" |
| 88 | delay) | 104 | delay) |
| 89 | (setq year (string-to-number (match-string 1 delay)) | 105 | (setq year (string-to-number (match-string 1 delay)) |
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index ad1c4c2731a..0097f590b43 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el | |||
| @@ -36,6 +36,10 @@ | |||
| 36 | ;;; Code: | 36 | ;;; Code: |
| 37 | 37 | ||
| 38 | (require 'icalendar) | 38 | (require 'icalendar) |
| 39 | (require 'icalendar-parser) | ||
| 40 | (eval-when-compile (require 'icalendar-macs)) | ||
| 41 | (require 'icalendar-ast) | ||
| 42 | (require 'icalendar-utils) | ||
| 39 | (require 'eieio) | 43 | (require 'eieio) |
| 40 | (require 'gmm-utils) | 44 | (require 'gmm-utils) |
| 41 | (require 'mm-decode) | 45 | (require 'mm-decode) |
| @@ -82,8 +86,8 @@ | |||
| 82 | :type (or null t)) | 86 | :type (or null t)) |
| 83 | (recur :initarg :recur | 87 | (recur :initarg :recur |
| 84 | :accessor gnus-icalendar-event:recur | 88 | :accessor gnus-icalendar-event:recur |
| 85 | :initform "" | 89 | :initform nil |
| 86 | :type (or null string)) | 90 | :type (or null list)) |
| 87 | (uid :initarg :uid | 91 | (uid :initarg :uid |
| 88 | :accessor gnus-icalendar-event:uid | 92 | :accessor gnus-icalendar-event:uid |
| 89 | :type string) | 93 | :type string) |
| @@ -127,295 +131,212 @@ | |||
| 127 | 131 | ||
| 128 | (cl-defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) | 132 | (cl-defmethod gnus-icalendar-event:recurring-freq ((event gnus-icalendar-event)) |
| 129 | "Return recurring frequency of EVENT." | 133 | "Return recurring frequency of EVENT." |
| 130 | (let ((rrule (gnus-icalendar-event:recur event))) | 134 | (ical:recur-freq (gnus-icalendar-event:recur event))) |
| 131 | (string-match "FREQ=\\([[:alpha:]]+\\)" rrule) | ||
| 132 | (match-string 1 rrule))) | ||
| 133 | 135 | ||
| 134 | (cl-defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) | 136 | (cl-defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event)) |
| 135 | "Return recurring interval of EVENT." | 137 | "Return recurring interval of EVENT." |
| 136 | (let ((rrule (gnus-icalendar-event:recur event)) | 138 | (ical:recur-interval-size (gnus-icalendar-event:recur event))) |
| 137 | (default-interval "1")) | ||
| 138 | |||
| 139 | (if (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule) | ||
| 140 | (match-string 1 rrule) | ||
| 141 | default-interval))) | ||
| 142 | 139 | ||
| 143 | (cl-defmethod gnus-icalendar-event:recurring-days ((event gnus-icalendar-event)) | 140 | (cl-defmethod gnus-icalendar-event:recurring-days ((event gnus-icalendar-event)) |
| 144 | "Return, when available, the week day numbers on which the EVENT recurs." | 141 | "Return, when available, the week day numbers on which the EVENT recurs." |
| 145 | (let ((rrule (gnus-icalendar-event:recur event)) | 142 | (let ((rrule (gnus-icalendar-event:recur event))) |
| 146 | (weekday-map '(("SU" . 0) | 143 | (when rrule |
| 147 | ("MO" . 1) | 144 | (mapcar (lambda (el) (if (consp el) (car el) el)) |
| 148 | ("TU" . 2) | 145 | (ical:recur-by* 'BYDAY rrule))))) |
| 149 | ("WE" . 3) | ||
| 150 | ("TH" . 4) | ||
| 151 | ("FR" . 5) | ||
| 152 | ("SA" . 6)))) | ||
| 153 | (when (and rrule (string-match "BYDAY=\\([^;]+\\)" rrule)) | ||
| 154 | (let ((bydays (split-string (match-string 1 rrule) ","))) | ||
| 155 | (seq-map | ||
| 156 | (lambda (x) (cdr (assoc x weekday-map))) | ||
| 157 | (seq-filter (lambda (x) (string-match "^[A-Z]\\{2\\}$" x)) bydays)))))) | ||
| 158 | 146 | ||
| 159 | (cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) | 147 | (cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event)) |
| 160 | (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) | 148 | (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event))) |
| 161 | 149 | ||
| 162 | (defun gnus-icalendar-event--decode-datefield (event field zone-map) | 150 | (defun gnus-icalendar-event--find-attendee (attendees ids) |
| 163 | (let* ((dtdate (icalendar--get-event-property event field)) | 151 | "Return the first `icalendar-attendee' in ATTENDEES matching IDS. |
| 164 | (dtdate-zone (icalendar--find-time-zone | 152 | IDS should be a list of strings. The first attendee is returned whose |
| 165 | (icalendar--get-event-property-attributes | 153 | name (as `icalendar-cnparam') or email address (without \"mailto:\") |
| 166 | event field) zone-map)) | 154 | is a member of IDS." |
| 167 | (dtdate-dec (icalendar--decode-isodatetime dtdate nil dtdate-zone))) | 155 | (catch 'found |
| 168 | (when dtdate-dec (encode-time dtdate-dec)))) | 156 | (dolist (attendee attendees) |
| 169 | 157 | (ical:with-property attendee ((ical:cnparam :value name)) | |
| 170 | (defun gnus-icalendar-event--find-attendee (ical name-or-email) | 158 | (let ((email (ical:strip-mailto value))) |
| 171 | (let* ((event (car (icalendar--all-events ical))) | 159 | (when (or (member name ids) |
| 172 | (event-props (caddr event))) | 160 | (member email ids)) |
| 173 | (cl-labels ((attendee-name (att) (plist-get (cadr att) 'CN)) | 161 | (throw 'found attendee))))))) |
| 174 | (attendee-email | 162 | |
| 175 | (att) | 163 | (defun gnus-icalendar-event--attendees-by-type (attendees) |
| 176 | (replace-regexp-in-string "^.*MAILTO:" "" (caddr att))) | 164 | "Return lists of required and optional participants in ATTENDEES. |
| 177 | (attendee-prop-matches-p | 165 | ATTENDEES must be a list of `icalendar-attendee' nodes. The returned |
| 178 | (prop) | 166 | list has the form (REQUIRED OPTIONAL), where each is a list of |
| 179 | (and (eq (car prop) 'ATTENDEE) | 167 | `icalendar-attendee' nodes." |
| 180 | (or (member (attendee-name prop) name-or-email) | 168 | (let (required optional) |
| 181 | (let ((att-email (attendee-email prop))) | 169 | (dolist (attendee attendees) |
| 182 | (gnus-icalendar-find-if | 170 | (ical:with-property attendee ((ical:roleparam :value role)) |
| 183 | (lambda (str-or-fun) | 171 | (when (or (null role) ; "REQ-PARTICIPANT" is the default |
| 184 | (if (functionp str-or-fun) | 172 | (equal role "REQ-PARTICIPANT")) |
| 185 | (funcall str-or-fun att-email) | 173 | (push attendee required)) |
| 186 | (string-match str-or-fun att-email))) | 174 | (when (equal role "OPT-PARTICIPANT") |
| 187 | name-or-email)))))) | 175 | (push attendee optional)))) |
| 188 | (gnus-icalendar-find-if #'attendee-prop-matches-p event-props)))) | 176 | (list (nreverse required) |
| 189 | 177 | (nreverse optional)))) | |
| 190 | (defun gnus-icalendar-event--get-attendee-names (ical) | 178 | |
| 191 | (let* ((event (car (icalendar--all-events ical))) | 179 | (defun gnus-icalendar-event-from-ical (vcalendar &optional ids) |
| 192 | (attendee-props (seq-filter | 180 | "Initialize an event instance with the first `icalendar-vevent' in VCALENDAR. |
| 193 | (lambda (p) (eq (car p) 'ATTENDEE)) | 181 | IDS should be a list of strings representing names and email addresses |
| 194 | (caddr event)))) | 182 | by which to identify an `icalendar-attendee' in the event as the |
| 195 | 183 | recipient." | |
| 196 | (cl-labels | 184 | (ical:with-component vcalendar |
| 197 | ((attendee-role (prop) | 185 | ((ical:vevent vevent) |
| 198 | ;; RFC5546: default ROLE is REQ-PARTICIPANT | 186 | (ical:method :value method)) |
| 199 | (and prop | 187 | (ical:with-component vevent |
| 200 | (or (plist-get (cadr prop) 'ROLE) | 188 | ((ical:organizer :value organizer) |
| 201 | "REQ-PARTICIPANT"))) | 189 | (ical:attendee :all attendees) |
| 202 | (attendee-name | 190 | (ical:summary :value summary) |
| 203 | (prop) | 191 | (ical:description :value description) |
| 204 | (or (plist-get (cadr prop) 'CN) | 192 | (ical:dtstart :value dtstart) |
| 205 | (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop)))) | 193 | (ical:dtend :value dtend) |
| 206 | (attendees-by-type (type) | 194 | (ical:location :value location) |
| 207 | (seq-filter | 195 | (ical:rrule :value rrule) |
| 208 | (lambda (p) (string= (attendee-role p) type)) | 196 | (ical:uid :value uid)) |
| 209 | attendee-props)) | 197 | |
| 210 | (attendee-names-by-type | 198 | (let* ((attendee (when ids (gnus-icalendar-event--find-attendee attendees ids))) |
| 211 | (type) | 199 | (rsvp-p (ical:with-param-of attendee 'ical:rsvpparam)) |
| 212 | (mapcar #'attendee-name (attendees-by-type type)))) | ||
| 213 | (list | ||
| 214 | (attendee-names-by-type "REQ-PARTICIPANT") | ||
| 215 | (attendee-names-by-type "OPT-PARTICIPANT"))))) | ||
| 216 | |||
| 217 | (defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email) | ||
| 218 | (let* ((event (car (icalendar--all-events ical))) | ||
| 219 | (organizer (replace-regexp-in-string | ||
| 220 | "^.*MAILTO:" "" | ||
| 221 | (or (icalendar--get-event-property event 'ORGANIZER) ""))) | ||
| 222 | (prop-map '((summary . SUMMARY) | ||
| 223 | (description . DESCRIPTION) | ||
| 224 | (location . LOCATION) | ||
| 225 | (recur . RRULE) | ||
| 226 | (uid . UID))) | ||
| 227 | (method (caddr (assoc 'METHOD (caddr (car (nreverse ical)))))) | ||
| 228 | (attendee (when attendee-name-or-email | ||
| 229 | (gnus-icalendar-event--find-attendee | ||
| 230 | ical attendee-name-or-email))) | ||
| 231 | (attendee-names (gnus-icalendar-event--get-attendee-names ical)) | ||
| 232 | ;; RFC5546: default ROLE is REQ-PARTICIPANT | 200 | ;; RFC5546: default ROLE is REQ-PARTICIPANT |
| 233 | (role (and attendee | 201 | (role (when attendee |
| 234 | (or (plist-get (cadr attendee) 'ROLE) | 202 | (or (ical:with-param-of attendee 'ical:roleparam) |
| 235 | "REQ-PARTICIPANT"))) | 203 | "REQ-PARTICIPANT"))) |
| 236 | (participation-type (pcase role | 204 | (participation-type (pcase role |
| 237 | ("REQ-PARTICIPANT" 'required) | 205 | ("REQ-PARTICIPANT" 'required) |
| 238 | ("OPT-PARTICIPANT" 'optional) | 206 | ("OPT-PARTICIPANT" 'optional) |
| 239 | (_ 'non-participant))) | 207 | (_ 'non-participant))) |
| 240 | (zone-map (icalendar--convert-all-timezones ical)) | 208 | (req/opt (gnus-icalendar-event--attendees-by-type attendees)) |
| 241 | (args | 209 | (args |
| 242 | (list :method method | 210 | (list :method method |
| 243 | :organizer organizer | 211 | :organizer (when organizer (ical:strip-mailto organizer)) |
| 244 | :start-time (gnus-icalendar-event--decode-datefield | 212 | :summary summary |
| 245 | event 'DTSTART zone-map) | 213 | :description description |
| 246 | :end-time (gnus-icalendar-event--decode-datefield | 214 | :location location |
| 247 | event 'DTEND zone-map) | 215 | :recur rrule |
| 248 | :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE") | 216 | :start-time (encode-time dtstart) |
| 217 | :end-time (encode-time dtend) | ||
| 218 | :rsvp rsvp-p | ||
| 249 | :participation-type participation-type | 219 | :participation-type participation-type |
| 250 | :req-participants (car attendee-names) | 220 | :req-participants (car req/opt) |
| 251 | :opt-participants (cadr attendee-names))) | 221 | :opt-participants (cadr req/opt) |
| 252 | (event-class | 222 | :uid (or uid ""))) ; UID must be a string |
| 253 | (cond | 223 | (event-class (pcase method |
| 254 | ((string= method "REQUEST") 'gnus-icalendar-event-request) | 224 | ("REQUEST" 'gnus-icalendar-event-request) |
| 255 | ((string= method "CANCEL") 'gnus-icalendar-event-cancel) | 225 | ("CANCEL" 'gnus-icalendar-event-cancel) |
| 256 | ((string= method "REPLY") 'gnus-icalendar-event-reply) | 226 | ("REPLY" 'gnus-icalendar-event-reply) |
| 257 | (t 'gnus-icalendar-event)))) | 227 | (_ 'gnus-icalendar-event)))) |
| 258 | (cl-labels | 228 | ;; Initialize and return the instance: |
| 259 | ((map-property | 229 | (apply |
| 260 | (prop) | 230 | #'make-instance |
| 261 | (let ((value (icalendar--get-event-property event prop))) | 231 | event-class |
| 262 | (when value | 232 | (cl-loop for slot in (eieio-class-slots event-class) |
| 263 | ;; ugly, but cannot get | 233 | for keyword = (intern |
| 264 | ;;replace-regexp-in-string work with "\\" as | 234 | (format ":%s" (eieio-slot-descriptor-name slot))) |
| 265 | ;;REP, plus we should also handle "\\;" | 235 | when (plist-member args keyword) |
| 266 | (string-replace | 236 | append (list keyword (plist-get args keyword)))))))) |
| 267 | "\\," "," | 237 | |
| 268 | (string-replace | 238 | (defun gnus-icalendar-event-from-buffer (buf &optional ids) |
| 269 | "\\n" "\n" (substring-no-properties value)))))) | ||
| 270 | (accumulate-args | ||
| 271 | (mapping) | ||
| 272 | (cl-destructuring-bind (slot . ical-property) mapping | ||
| 273 | (setq args (append (list | ||
| 274 | (intern (concat ":" (symbol-name slot))) | ||
| 275 | (map-property ical-property)) | ||
| 276 | args))))) | ||
| 277 | (mapc #'accumulate-args prop-map) | ||
| 278 | (apply | ||
| 279 | #'make-instance | ||
| 280 | event-class | ||
| 281 | (cl-loop for slot in (eieio-class-slots event-class) | ||
| 282 | for keyword = (intern | ||
| 283 | (format ":%s" (eieio-slot-descriptor-name slot))) | ||
| 284 | when (plist-member args keyword) | ||
| 285 | append (list keyword | ||
| 286 | (if (eq keyword :uid) | ||
| 287 | ;; The UID has to be a string. | ||
| 288 | (or (plist-get args keyword) "") | ||
| 289 | (plist-get args keyword)))))))) | ||
| 290 | |||
| 291 | (defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) | ||
| 292 | "Parse RFC5545 iCalendar in buffer BUF and return an event object. | 239 | "Parse RFC5545 iCalendar in buffer BUF and return an event object. |
| 293 | 240 | ||
| 294 | Return a gnus-icalendar-event object representing the first event | 241 | Return a gnus-icalendar-event object representing the first event |
| 295 | contained in the invitation. Return nil for calendars without an | 242 | contained in the invitation. Return nil for calendars without an |
| 296 | event entry. | 243 | event entry. |
| 297 | 244 | ||
| 298 | ATTENDEE-NAME-OR-EMAIL is a list of strings that will be matched | 245 | IDS is a list of strings that identify the recipient |
| 299 | against the event's attendee names and emails. Invitation rsvp | 246 | `icalendar-attendee' by name or email address. Invitation rsvp status |
| 300 | status will be retrieved from the first matching attendee record." | 247 | will be retrieved from the first matching attendee record." |
| 301 | (let ((ical (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) | 248 | (let ((vcalendar (ical:parse buf))) |
| 302 | (goto-char (point-min)) | 249 | (when vcalendar |
| 303 | (icalendar--read-element nil nil)))) | 250 | (gnus-icalendar-event-from-ical vcalendar ids)))) |
| 304 | |||
| 305 | (when ical | ||
| 306 | (gnus-icalendar-event-from-ical ical attendee-name-or-email)))) | ||
| 307 | 251 | ||
| 308 | ;;; | 252 | ;;; |
| 309 | ;;; gnus-icalendar-event-reply | 253 | ;;; gnus-icalendar-event-reply |
| 310 | ;;; | 254 | ;;; |
| 311 | 255 | ||
| 312 | (defun gnus-icalendar-event--build-reply-event-body (ical-request status identities &optional comment) | 256 | (defun gnus-icalendar-event--build-reply (vcalendar status ids &optional comment) |
| 257 | "Return an `icalendar-vcalendar' based on VCALENDAR with updated STATUS. | ||
| 258 | STATUS should one of \\='accepted, \\='declined, or \\='tentative. The | ||
| 259 | recipient whose participation status is updated to STATUS is identified | ||
| 260 | in EVENT by finding an `icalendar-attendee' whose name or email address | ||
| 261 | matches one of the strings in IDS. If no such attendee is found, a new | ||
| 262 | `icalendar-attendee' is added from the values of `user-mail-address' and | ||
| 263 | `user-full-name'. COMMENT, if provided, will be added as an | ||
| 264 | `icalendar-comment' to the returned event." | ||
| 313 | (let ((summary-status (capitalize (symbol-name status))) | 265 | (let ((summary-status (capitalize (symbol-name status))) |
| 314 | (attendee-status (upcase (symbol-name status))) | 266 | (attendee-status (upcase (symbol-name status))) |
| 315 | reply-event-lines) | 267 | recipient) |
| 316 | (cl-labels | 268 | (ical:with-component vcalendar |
| 317 | ((update-summary | 269 | ((ical:vtimezone :all tz-nodes) |
| 318 | (line) | 270 | (ical:vevent :first vevent)) |
| 319 | (if (string-match "^[^:]+:" line) | 271 | (ical:with-component vevent |
| 320 | (replace-match (format "\\&%s: " summary-status) t nil line) | 272 | ((ical:summary :value summary) |
| 321 | line)) | 273 | (ical:attendee :all attendees) |
| 322 | (update-comment | 274 | (ical:uid :value uid) |
| 323 | (line) | 275 | (ical:comment :value old-comment) |
| 324 | (if comment (format "COMMENT:%s" comment) | 276 | ;; The nodes below are copied unchanged to the reply. Not all |
| 325 | line)) | 277 | ;; of them are mandatory, but they are often present in other |
| 326 | (update-dtstamp () | 278 | ;; clients' replies. Can be helpful for debugging, too. |
| 327 | (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) | 279 | (ical:organizer :first organizer-node) |
| 328 | (attendee-matches-identity | 280 | (ical:dtstart :first dtstart-node) |
| 329 | (line) | 281 | (ical:dtend :first dtend-node) |
| 330 | (gnus-icalendar-find-if (lambda (name) (string-match-p name line)) | 282 | (ical:duration :first duration-node) |
| 331 | identities)) | 283 | (ical:location :first location-node) |
| 332 | (update-attendee-status | 284 | (ical:sequence :first sequence-node) |
| 333 | (line) | 285 | (ical:recurrence-id :first recid-node)) |
| 334 | (when (and (attendee-matches-identity line) | 286 | |
| 335 | (string-match "\\(PARTSTAT=\\)[^;]+" line)) | 287 | (setq recipient (gnus-icalendar-event--find-attendee attendees ids)) |
| 336 | (replace-match (format "\\1%s" attendee-status) t nil line))) | 288 | (if recipient |
| 337 | (process-event-line | 289 | (ical:with-property recipient |
| 338 | (line) | 290 | ((ical:partstatparam :first partstat-node)) |
| 339 | (when (string-match "^\\([^;:]+\\)" line) | 291 | (ical:ast-node-set-value partstat-node attendee-status)) |
| 340 | (let* ((key (match-string 0 line)) | 292 | ;; RFC5546 refers to uninvited attendees as "party crashers". |
| 341 | ;; NOTE: not all of the below fields are mandatory, | 293 | ;; This situation is common if the invitation is sent to a group |
| 342 | ;; but they are often present in other clients' | 294 | ;; of people via a mailing list. |
| 343 | ;; replies. Can be helpful for debugging, too. | 295 | (lwarn 'gnus-icalendar :warning |
| 344 | (new-line | 296 | "Could not find a matching event attendee; creating new.") |
| 345 | (cond | 297 | (setq recipient |
| 346 | ((string= key "ATTENDEE") (update-attendee-status line)) | 298 | (ical:make-property ical:attendee |
| 347 | ((string= key "SUMMARY") (update-summary line)) | 299 | (concat "mailto:" user-mail-address) |
| 348 | ((string= key "COMMENT") (update-comment line)) | 300 | (ical:partstatparam attendee-status) |
| 349 | ((string= key "DTSTAMP") (update-dtstamp)) | 301 | (ical:cnparam user-full-name))) |
| 350 | ((member key '("ORGANIZER" "DTSTART" "DTEND" | 302 | (push recipient attendees)) |
| 351 | "LOCATION" "DURATION" "SEQUENCE" | 303 | |
| 352 | "RECURRENCE-ID" "UID")) | 304 | ;; Build the reply: |
| 353 | line) | 305 | (ical:make-vcalendar |
| 354 | (t nil)))) | 306 | (ical:method "REPLY") |
| 355 | (when new-line | 307 | (@ tz-nodes) |
| 356 | (push new-line reply-event-lines)))))) | 308 | (ical:vevent |
| 357 | 309 | (ical:uid uid) | |
| 358 | (mapc #'process-event-line (split-string ical-request "\n")) | 310 | recid-node |
| 359 | 311 | sequence-node | |
| 360 | ;; RFC5546 refers to uninvited attendees as "party crashers". | 312 | organizer-node |
| 361 | ;; This situation is common if the invitation is sent to a group | 313 | dtstart-node |
| 362 | ;; of people via a mailing list. | 314 | dtend-node |
| 363 | (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) | 315 | duration-node |
| 364 | reply-event-lines) | 316 | location-node |
| 365 | (lwarn 'gnus-icalendar :warning | 317 | (ical:summary |
| 366 | "Could not find an event attendee matching given identity") | 318 | (if (string-match "^[^:]+:" summary) |
| 367 | (push (format "ATTENDEE;RSVP=TRUE;PARTSTAT=%s;CN=%s:MAILTO:%s" | 319 | (replace-match (format "\\&%s: " summary-status) t nil summary) |
| 368 | attendee-status user-full-name user-mail-address) | 320 | summary)) |
| 369 | reply-event-lines)) | 321 | (ical:comment (or comment old-comment)) |
| 370 | 322 | (@ attendees))))))) | |
| 371 | ;; add comment line if not existing | 323 | |
| 372 | (when (and comment | 324 | (defun gnus-icalendar-event-reply-from-buffer (buf status ids |
| 373 | (not (gnus-icalendar-find-if | 325 | &optional comment) |
| 374 | (lambda (x) | ||
| 375 | (string-match "^COMMENT" x)) | ||
| 376 | reply-event-lines))) | ||
| 377 | (push (format "COMMENT:%s" comment) reply-event-lines)) | ||
| 378 | |||
| 379 | (mapconcat #'identity `("BEGIN:VEVENT" | ||
| 380 | ,@(nreverse reply-event-lines) | ||
| 381 | "END:VEVENT") | ||
| 382 | "\n")))) | ||
| 383 | |||
| 384 | (defun gnus-icalendar-event-reply-from-buffer (buf status identities &optional comment) | ||
| 385 | "Build a calendar event reply for request contained in BUF. | 326 | "Build a calendar event reply for request contained in BUF. |
| 386 | The reply will have STATUS (`accepted', `tentative' or `declined'). | 327 | The reply will have STATUS (`accepted', `tentative' or `declined'). The |
| 387 | The reply will be composed for attendees matching any entry | 328 | reply will be composed for attendees matching any entry in the |
| 388 | on the IDENTITIES list. | 329 | IDS list. Optional argument COMMENT will be placed in the |
| 389 | Optional argument COMMENT will be placed in the comment field of the | 330 | comment field of the reply." |
| 390 | reply. | 331 | (let (vcalendar reply) |
| 391 | " | 332 | (with-current-buffer (ical:unfolded-buffer-from-buffer (get-buffer buf)) |
| 392 | (cl-labels | 333 | (setq vcalendar (ical:parse)) |
| 393 | ((extract-block | 334 | (unless vcalendar |
| 394 | (blockname) | 335 | (error "Could not parse invitation; see buffer %s" |
| 395 | (save-excursion | 336 | (buffer-name (ical:error-buffer)))) |
| 396 | (let ((block-start-re (format "^BEGIN:%s" blockname)) | 337 | (setq reply |
| 397 | (block-end-re (format "^END:%s" blockname)) | 338 | (gnus-icalendar-event--build-reply vcalendar status ids comment)) |
| 398 | start) | 339 | (ical:print-calendar-node reply)))) |
| 399 | (when (re-search-forward block-start-re nil t) | ||
| 400 | (setq start (line-beginning-position)) | ||
| 401 | (re-search-forward block-end-re) | ||
| 402 | (buffer-substring-no-properties start (line-end-position))))))) | ||
| 403 | (let (zone event) | ||
| 404 | (with-current-buffer (icalendar--get-unfolded-buffer (get-buffer buf)) | ||
| 405 | (goto-char (point-min)) | ||
| 406 | (setq zone (extract-block "VTIMEZONE") | ||
| 407 | event (extract-block "VEVENT"))) | ||
| 408 | |||
| 409 | (when event | ||
| 410 | (let ((contents (list "BEGIN:VCALENDAR" | ||
| 411 | "METHOD:REPLY" | ||
| 412 | "PRODID:Gnus" | ||
| 413 | "VERSION:2.0" | ||
| 414 | zone | ||
| 415 | (gnus-icalendar-event--build-reply-event-body event status identities comment) | ||
| 416 | "END:VCALENDAR"))) | ||
| 417 | |||
| 418 | (mapconcat #'identity (delq nil contents) "\n")))))) | ||
| 419 | 340 | ||
| 420 | ;;; | 341 | ;;; |
| 421 | ;;; gnus-icalendar-org | 342 | ;;; gnus-icalendar-org |
| @@ -455,15 +376,17 @@ reply. | |||
| 455 | "Return `org-mode' timestamp repeater string for recurring EVENT. | 376 | "Return `org-mode' timestamp repeater string for recurring EVENT. |
| 456 | Return nil for non-recurring EVENT." | 377 | Return nil for non-recurring EVENT." |
| 457 | (when (gnus-icalendar-event:recurring-p event) | 378 | (when (gnus-icalendar-event:recurring-p event) |
| 458 | (let* ((freq-map '(("HOURLY" . "h") | 379 | (let* ((freq-map '((HOURLY . "h") |
| 459 | ("DAILY" . "d") | 380 | (DAILY . "d") |
| 460 | ("WEEKLY" . "w") | 381 | (WEEKLY . "w") |
| 461 | ("MONTHLY" . "m") | 382 | (MONTHLY . "m") |
| 462 | ("YEARLY" . "y"))) | 383 | (YEARLY . "y"))) |
| 463 | (org-freq (cdr (assoc (gnus-icalendar-event:recurring-freq event) freq-map)))) | 384 | (org-freq |
| 385 | (alist-get (gnus-icalendar-event:recurring-freq event) freq-map)) | ||
| 386 | (interval-size (gnus-icalendar-event:recurring-interval event))) | ||
| 464 | 387 | ||
| 465 | (when org-freq | 388 | (when org-freq |
| 466 | (format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq))))) | 389 | (format "+%d%s" interval-size org-freq))))) |
| 467 | 390 | ||
| 468 | (defun gnus-icalendar--find-day (start-date end-date day) | 391 | (defun gnus-icalendar--find-day (start-date end-date day) |
| 469 | (let ((time-1-day 86400)) | 392 | (let ((time-1-day 86400)) |
| @@ -550,7 +473,18 @@ Return nil for non-recurring EVENT." | |||
| 550 | 473 | ||
| 551 | 474 | ||
| 552 | (defun gnus-icalendar--format-participant-list (participants) | 475 | (defun gnus-icalendar--format-participant-list (participants) |
| 553 | (mapconcat #'identity participants ", ")) | 476 | "Format PARTICIPANTS as a comma-separated list. |
| 477 | |||
| 478 | Each `icalendar-attendee' in PARTICIPANTS will be represented like | ||
| 479 | A. Person <a.person@example.domain> | ||
| 480 | or simply: <a.person@example.domain>, if no `icalendar-cnparam' is present." | ||
| 481 | (mapconcat | ||
| 482 | (lambda (attendee) | ||
| 483 | (ical:with-property attendee ((ical:cnparam :value cn)) | ||
| 484 | (if cn | ||
| 485 | (format "%s <%s>" cn value) | ||
| 486 | (format "<%s>" value)))) | ||
| 487 | participants ", ")) | ||
| 554 | 488 | ||
| 555 | ;; TODO: make the template customizable | 489 | ;; TODO: make the template customizable |
| 556 | (cl-defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) | 490 | (cl-defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status) |
| @@ -1110,3 +1044,7 @@ means prompt for a comment to include in the reply." | |||
| 1110 | (provide 'gnus-icalendar) | 1044 | (provide 'gnus-icalendar) |
| 1111 | 1045 | ||
| 1112 | ;;; gnus-icalendar.el ends here | 1046 | ;;; gnus-icalendar.el ends here |
| 1047 | |||
| 1048 | ;; Local Variables: | ||
| 1049 | ;; read-symbol-shorthands: (("ical:" . "icalendar-")) | ||
| 1050 | ;; End: | ||
diff --git a/lisp/help.el b/lisp/help.el index 49d4659ab02..1576fb61dc8 100644 --- a/lisp/help.el +++ b/lisp/help.el | |||
| @@ -2356,11 +2356,13 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." | |||
| 2356 | "Return a formal argument list for the function DEF. | 2356 | "Return a formal argument list for the function DEF. |
| 2357 | If PRESERVE-NAMES is non-nil, return a formal arglist that uses | 2357 | If PRESERVE-NAMES is non-nil, return a formal arglist that uses |
| 2358 | the same names as used in the original source code, when possible." | 2358 | the same names as used in the original source code, when possible." |
| 2359 | (let ((orig-def def) | 2359 | (let ((orig-def def)) |
| 2360 | ;; Advice wrappers have "catch all" args, so fetch the actual underlying | 2360 | (let ((seen nil)) |
| 2361 | ;; function to find the real arguments. | 2361 | ;; Advice wrappers have "catch all" args, so fetch the actual underlying |
| 2362 | (def (advice--cd*r | 2362 | ;; function to find the real arguments. Also follow aliases. |
| 2363 | (indirect-function def)))) ;; Follow aliases to other symbols. | 2363 | (while (not (memq def seen)) |
| 2364 | (push def seen) | ||
| 2365 | (setq def (advice--cd*r (indirect-function def))))) | ||
| 2364 | ;; If definition is a macro, find the function inside it. | 2366 | ;; If definition is a macro, find the function inside it. |
| 2365 | (if (eq (car-safe def) 'macro) (setq def (cdr def))) | 2367 | (if (eq (car-safe def) 'macro) (setq def (cdr def))) |
| 2366 | (cond | 2368 | (cond |
diff --git a/lisp/info.el b/lisp/info.el index 368255092a1..320ac7de65c 100644 --- a/lisp/info.el +++ b/lisp/info.el | |||
| @@ -1897,8 +1897,10 @@ of NODENAME; if none is found it then tries a case-insensitive match | |||
| 1897 | (if (equal nodename "") "Top" nodename) nil strict-case))) | 1897 | (if (equal nodename "") "Top" nodename) nil strict-case))) |
| 1898 | 1898 | ||
| 1899 | (defun Info-goto-node-web (node) | 1899 | (defun Info-goto-node-web (node) |
| 1900 | "Use `browse-url' to go to the gnu.org web server's version of NODE. | 1900 | "Use `browse-url' to go to the gnu.org Web server's version of NODE. |
| 1901 | By default, go to the current Info node." | 1901 | By default, go to the URL corresponding to the current Info node. |
| 1902 | |||
| 1903 | This uses `Info-url-for-node' to determine the URL that corresponds to NODE." | ||
| 1902 | (interactive (list (Info-read-node-name | 1904 | (interactive (list (Info-read-node-name |
| 1903 | "Go to node (default current page): " Info-current-node)) | 1905 | "Go to node (default current page): " Info-current-node)) |
| 1904 | Info-mode) | 1906 | Info-mode) |
| @@ -1924,7 +1926,10 @@ By default, go to the current Info node." | |||
| 1924 | (defun Info-url-for-node (node) | 1926 | (defun Info-url-for-node (node) |
| 1925 | "Return the URL corresponding to NODE. | 1927 | "Return the URL corresponding to NODE. |
| 1926 | 1928 | ||
| 1927 | NODE should be a string of the form \"(manual)Node\"." | 1929 | NODE should be a string of the form \"(manual)Node\". |
| 1930 | |||
| 1931 | The correspondence between Info manuals and their Web URLs is | ||
| 1932 | established by `Info-url-alist', which see." | ||
| 1928 | ;; GNU Texinfo skips whitespaces and newlines between the closing | 1933 | ;; GNU Texinfo skips whitespaces and newlines between the closing |
| 1929 | ;; parenthesis and the node-name, i.e. space, tab, line feed and | 1934 | ;; parenthesis and the node-name, i.e. space, tab, line feed and |
| 1930 | ;; carriage return. | 1935 | ;; carriage return. |
diff --git a/lisp/international/characters.el b/lisp/international/characters.el index ba994daa852..d19802c46fd 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el | |||
| @@ -1782,15 +1782,15 @@ Setup `char-width-table' appropriate for non-CJK language environment." | |||
| 1782 | (let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL" | 1782 | (let ((c0-acronyms '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL" |
| 1783 | "BS" nil nil "VT" "FF" "CR" "SO" "SI" | 1783 | "BS" nil nil "VT" "FF" "CR" "SO" "SI" |
| 1784 | "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" | 1784 | "DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" |
| 1785 | "CAN" "EM" "SUB" "ESC" "FC" "GS" "RS" "US"))) | 1785 | "CAN" "EM" "SUB" "ESC" "FS" "GS" "RS" "US"))) |
| 1786 | (dotimes (i 32) | 1786 | (dotimes (i 32) |
| 1787 | (aset char-acronym-table i (car c0-acronyms)) | 1787 | (aset char-acronym-table i (car c0-acronyms)) |
| 1788 | (setq c0-acronyms (cdr c0-acronyms)))) | 1788 | (setq c0-acronyms (cdr c0-acronyms)))) |
| 1789 | 1789 | ||
| 1790 | (let ((c1-acronyms '("PAD" "HOP" "BPH" "NBH" "IND" "NEL" "SSA" "ESA" | 1790 | (let ((c1-acronyms '("PAD" "HOP" "BPH" "NBH" "IND" "NEL" "SSA" "ESA" |
| 1791 | "HTS" "HTJ" "VTS" "PLD" "PLU" "R1" "SS2" "SS1" | 1791 | "HTS" "HTJ" "VTS" "PLD" "PLU" "RI" "SS2" "SS3" |
| 1792 | "DCS" "PU1" "PU2" "STS" "CCH" "MW" "SPA" "EPA" | 1792 | "DCS" "PU1" "PU2" "STS" "CCH" "MW" "SPA" "EPA" |
| 1793 | "SOS" "SGCI" "SC1" "CSI" "ST" "OSC" "PM" "APC"))) | 1793 | "SOS" "SGCI" "SCI" "CSI" "ST" "OSC" "PM" "APC"))) |
| 1794 | (dotimes (i 32) | 1794 | (dotimes (i 32) |
| 1795 | (aset char-acronym-table (+ #x0080 i) (car c1-acronyms)) | 1795 | (aset char-acronym-table (+ #x0080 i) (car c1-acronyms)) |
| 1796 | (setq c1-acronyms (cdr c1-acronyms)))) | 1796 | (setq c1-acronyms (cdr c1-acronyms)))) |
diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index d8e779f7d8d..56a8134be81 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el | |||
| @@ -155,9 +155,13 @@ and also consults the `emoji-alternate-names' alist." | |||
| 155 | 155 | ||
| 156 | ;;;###autoload | 156 | ;;;###autoload |
| 157 | (defun emoji-list () | 157 | (defun emoji-list () |
| 158 | "List emojis and allow selecting and inserting one of them. | 158 | "List Emoji and allow selecting and inserting one of them. |
| 159 | If you are displaying Emoji on a text-only terminal, and some | ||
| 160 | of them look incorrect, or there are display artifacts when | ||
| 161 | scrolling the display, turn off `auto-composition-mode'. | ||
| 162 | |||
| 159 | Select the emoji by typing \\<emoji-list-mode-map>\\[emoji-list-select] on its picture. | 163 | Select the emoji by typing \\<emoji-list-mode-map>\\[emoji-list-select] on its picture. |
| 160 | The glyph will be inserted into the buffer that was current | 164 | The selected glyph will be inserted into the buffer that was current |
| 161 | when the command was invoked." | 165 | when the command was invoked." |
| 162 | (interactive) | 166 | (interactive) |
| 163 | (let ((buf (current-buffer))) | 167 | (let ((buf (current-buffer))) |
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index fca00dd2fc7..e8930fd2d4e 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el | |||
| @@ -4,7 +4,7 @@ | |||
| 4 | 4 | ||
| 5 | ;; Author: João Távora <joaotavora@gmail.com> | 5 | ;; Author: João Távora <joaotavora@gmail.com> |
| 6 | ;; Keywords: processes, languages, extensions | 6 | ;; Keywords: processes, languages, extensions |
| 7 | ;; Version: 1.0.27 | 7 | ;; Version: 1.0.28 |
| 8 | ;; Package-Requires: ((emacs "25.2")) | 8 | ;; Package-Requires: ((emacs "25.2")) |
| 9 | 9 | ||
| 10 | ;; This is a GNU ELPA :core package. Avoid functionality that is not | 10 | ;; This is a GNU ELPA :core package. Avoid functionality that is not |
diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 982ae38f47d..b88c716f0b3 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el | |||
| @@ -219,7 +219,7 @@ macro to be executed before appending to it." | |||
| 219 | ;;;###autoload (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap) | 219 | ;;;###autoload (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap) |
| 220 | 220 | ||
| 221 | (if kmacro-call-mouse-event | 221 | (if kmacro-call-mouse-event |
| 222 | (global-set-key (vector kmacro-call-mouse-event) #'kmacro-end-call-mouse)) | 222 | (global-set-key (vector kmacro-call-mouse-event) #'kmacro-end-and-call-macro)) |
| 223 | 223 | ||
| 224 | 224 | ||
| 225 | ;;; Called from keyboard-quit | 225 | ;;; Called from keyboard-quit |
| @@ -742,8 +742,8 @@ With numeric ARG, repeat the macro that many times, | |||
| 742 | counting the definition just completed as the first repetition. | 742 | counting the definition just completed as the first repetition. |
| 743 | An argument of zero means repeat until error." | 743 | An argument of zero means repeat until error." |
| 744 | (interactive "p") | 744 | (interactive "p") |
| 745 | ;; Isearch may push the kmacro-end-macro key sequence onto the macro. | 745 | ;; Isearch may push the kmacro-end-macro key sequence onto the macro. |
| 746 | ;; Just ignore it when executing the macro. | 746 | ;; Just ignore it when executing the macro. FIXME: When?Why? |
| 747 | (unless executing-kbd-macro | 747 | (unless executing-kbd-macro |
| 748 | (end-kbd-macro arg #'kmacro-loop-setup-function) | 748 | (end-kbd-macro arg #'kmacro-loop-setup-function) |
| 749 | (when (and last-kbd-macro (= (length last-kbd-macro) 0)) | 749 | (when (and last-kbd-macro (= (length last-kbd-macro) 0)) |
| @@ -880,35 +880,25 @@ With \\[universal-argument], call second macro in macro ring." | |||
| 880 | 880 | ||
| 881 | 881 | ||
| 882 | ;;;###autoload | 882 | ;;;###autoload |
| 883 | (defun kmacro-end-and-call-macro (arg &optional no-repeat) | 883 | (defun kmacro-end-and-call-macro (arg &optional no-repeat event) |
| 884 | "Call last keyboard macro, ending it first if currently being defined. | 884 | "Call last keyboard macro, ending it first if currently being defined. |
| 885 | With numeric prefix ARG, repeat macro that many times. | 885 | With numeric prefix ARG, repeat macro that many times. |
| 886 | Zero argument means repeat until there is an error. | 886 | Zero argument means repeat until there is an error. |
| 887 | If triggered via a mouse EVENT, moves point to the position clicked | ||
| 888 | with the mouse before calling the macro. | ||
| 887 | 889 | ||
| 888 | To give a macro a name, so you can call it even after defining other | 890 | To give a macro a name, so you can call it even after defining other |
| 889 | macros, use \\[kmacro-name-last-macro]." | 891 | macros, use \\[kmacro-name-last-macro]." |
| 890 | (interactive "p") | 892 | (interactive (list current-prefix-arg nil |
| 893 | (if (consp last-input-event) last-input-event))) | ||
| 891 | (if defining-kbd-macro | 894 | (if defining-kbd-macro |
| 892 | (kmacro-end-macro nil)) | 895 | (kmacro-end-macro nil)) |
| 896 | (if event (mouse-set-point event)) | ||
| 893 | (kmacro-call-macro arg no-repeat)) | 897 | (kmacro-call-macro arg no-repeat)) |
| 894 | 898 | ||
| 895 | |||
| 896 | ;;;###autoload | 899 | ;;;###autoload |
| 897 | (defun kmacro-end-call-mouse (event) | 900 | (define-obsolete-function-alias 'kmacro-end-call-mouse |
| 898 | "Move point to the position clicked with the mouse and call last kbd macro. | 901 | #'kmacro-end-and-call-macro "31.1") |
| 899 | If kbd macro currently being defined end it before activating it." | ||
| 900 | (interactive "e") | ||
| 901 | (when defining-kbd-macro | ||
| 902 | (end-kbd-macro) | ||
| 903 | (when (and last-kbd-macro (= (length last-kbd-macro) 0)) | ||
| 904 | (setq last-kbd-macro nil) | ||
| 905 | (message "Ignore empty macro") | ||
| 906 | ;; Don't call `kmacro-ring-empty-p' to avoid its messages. | ||
| 907 | (while (and (null last-kbd-macro) kmacro-ring) | ||
| 908 | (kmacro-pop-ring1)))) | ||
| 909 | (mouse-set-point event) | ||
| 910 | (kmacro-call-macro nil t)) | ||
| 911 | |||
| 912 | 902 | ||
| 913 | ;;; Misc. commands | 903 | ;;; Misc. commands |
| 914 | 904 | ||
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el index da91e692719..cca702f71b0 100644 --- a/lisp/language/korea-util.el +++ b/lisp/language/korea-util.el | |||
| @@ -27,13 +27,22 @@ | |||
| 27 | 27 | ||
| 28 | ;;; Code: | 28 | ;;; Code: |
| 29 | 29 | ||
| 30 | (defgroup korean nil | ||
| 31 | "Options for writing Korean." | ||
| 32 | :version "31.1" | ||
| 33 | :group 'languages) | ||
| 34 | |||
| 30 | ;;;###autoload | 35 | ;;;###autoload |
| 31 | (defvar default-korean-keyboard | 36 | (defcustom default-korean-keyboard |
| 32 | (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) | 37 | (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) |
| 33 | "3" | 38 | "3" |
| 34 | "") | 39 | "") |
| 35 | "The kind of Korean keyboard for Korean (Hangul) input method. | 40 | "The kind of Korean keyboard for Korean (Hangul) input method. |
| 36 | \"\" for 2, \"3\" for 3, and \"3f\" for 3f.") | 41 | \"\" for 2, \"3\" for 3, and \"3f\" for 3f." |
| 42 | :initialize #'custom-initialize-delay | ||
| 43 | :group 'korean | ||
| 44 | :version "31.1" | ||
| 45 | :type 'string) | ||
| 37 | 46 | ||
| 38 | ;; functions useful for Korean text input | 47 | ;; functions useful for Korean text input |
| 39 | 48 | ||
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 44e8665eebd..f96cd43eca6 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el | |||
| @@ -231,8 +231,8 @@ in the tool bar will close the current window where possible." | |||
| 231 | '(menu-item "Open Project Directory" project-dired | 231 | '(menu-item "Open Project Directory" project-dired |
| 232 | :enable (menu-bar-non-minibuffer-window-p) | 232 | :enable (menu-bar-non-minibuffer-window-p) |
| 233 | :help "Read the root directory of the current project, to operate on its files")) | 233 | :help "Read the root directory of the current project, to operate on its files")) |
| 234 | (define-key menu [dired] | 234 | (define-key menu [open-directory] |
| 235 | '(menu-item "Open Directory..." dired | 235 | '(menu-item "Open Directory..." dired-from-menubar |
| 236 | :enable (menu-bar-non-minibuffer-window-p) | 236 | :enable (menu-bar-non-minibuffer-window-p) |
| 237 | :help "Read a directory, to operate on its files")) | 237 | :help "Read a directory, to operate on its files")) |
| 238 | (define-key menu [project-open-file] | 238 | (define-key menu [project-open-file] |
| @@ -2287,7 +2287,7 @@ this frame." | |||
| 2287 | (and menu-bar-close-window | 2287 | (and menu-bar-close-window |
| 2288 | (window-parent (selected-window))))) | 2288 | (window-parent (selected-window))))) |
| 2289 | 2289 | ||
| 2290 | (put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p)) | 2290 | (put 'dired-from-menubar 'menu-enable '(menu-bar-non-minibuffer-window-p)) |
| 2291 | 2291 | ||
| 2292 | ;; Permit deleting frame if it would leave a visible or iconified frame. | 2292 | ;; Permit deleting frame if it would leave a visible or iconified frame. |
| 2293 | (defun delete-frame-enabled-p () | 2293 | (defun delete-frame-enabled-p () |
| @@ -2496,8 +2496,7 @@ It must accept a buffer as its only required argument.") | |||
| 2496 | ;; Ignore the initial frame if present. It can happen if | 2496 | ;; Ignore the initial frame if present. It can happen if |
| 2497 | ;; Emacs was started as a daemon. (bug#53740) | 2497 | ;; Emacs was started as a daemon. (bug#53740) |
| 2498 | (dolist (frame (frame-list)) | 2498 | (dolist (frame (frame-list)) |
| 2499 | (unless (equal (terminal-name (frame-terminal frame)) | 2499 | (unless (frame-initial-p frame) |
| 2500 | "initial_terminal") | ||
| 2501 | (push frame frames))) | 2500 | (push frame frames))) |
| 2502 | ;; Make the menu of buffers proper. | 2501 | ;; Make the menu of buffers proper. |
| 2503 | (setq buffers-menu | 2502 | (setq buffers-menu |
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 13d0e712821..94fc63440b4 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -2807,7 +2807,7 @@ has been requested by the completion table." | |||
| 2807 | "Update displayed *Completions* buffer after change in buffer contents." | 2807 | "Update displayed *Completions* buffer after change in buffer contents." |
| 2808 | (if (not (or (minibufferp nil t) completion-in-region-mode)) | 2808 | (if (not (or (minibufferp nil t) completion-in-region-mode)) |
| 2809 | (remove-hook 'after-change-functions #'completions--after-change t) | 2809 | (remove-hook 'after-change-functions #'completions--after-change t) |
| 2810 | (when-let* ((window (get-buffer-window "*Completions*" 0))) | 2810 | (when-let* ((window (get-buffer-window "*Completions*" 'visible))) |
| 2811 | (when completion-auto-deselect | 2811 | (when completion-auto-deselect |
| 2812 | (with-selected-window window | 2812 | (with-selected-window window |
| 2813 | (completions--deselect)))) | 2813 | (completions--deselect)))) |
| @@ -3480,7 +3480,7 @@ in the minibuffer window." | |||
| 3480 | 3480 | ||
| 3481 | (defun minibuffer--completions-visible () | 3481 | (defun minibuffer--completions-visible () |
| 3482 | "Return the window where the current *Completions* buffer is visible, if any." | 3482 | "Return the window where the current *Completions* buffer is visible, if any." |
| 3483 | (when-let* ((window (get-buffer-window "*Completions*" 0))) | 3483 | (when-let* ((window (get-buffer-window "*Completions*" 'visible))) |
| 3484 | (let ((reference-buffer | 3484 | (let ((reference-buffer |
| 3485 | (buffer-local-value 'completion-reference-buffer | 3485 | (buffer-local-value 'completion-reference-buffer |
| 3486 | (window-buffer window)))) | 3486 | (window-buffer window)))) |
diff --git a/lisp/net/imap.el b/lisp/net/imap.el index bb298d11d3c..a09cd730c0f 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el | |||
| @@ -870,7 +870,8 @@ t if it successfully authenticates, nil otherwise." | |||
| 870 | (base64-encode-string | 870 | (base64-encode-string |
| 871 | (format "\000%s\000%s" | 871 | (format "\000%s\000%s" |
| 872 | (imap-quote-specials user) | 872 | (imap-quote-specials user) |
| 873 | (imap-quote-specials passwd))))))))) | 873 | (imap-quote-specials passwd)) |
| 874 | t))))))) | ||
| 874 | 875 | ||
| 875 | (defun imap-anonymous-p (_buffer) | 876 | (defun imap-anonymous-p (_buffer) |
| 876 | t) | 877 | t) |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c20b5df9b59..f6bfd9ebbea 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -451,21 +451,13 @@ Emacs dired can't find files." | |||
| 451 | (defun tramp-adb-handle-file-name-all-completions (filename directory) | 451 | (defun tramp-adb-handle-file-name-all-completions (filename directory) |
| 452 | "Like `file-name-all-completions' for Tramp files." | 452 | "Like `file-name-all-completions' for Tramp files." |
| 453 | (tramp-skeleton-file-name-all-completions filename directory | 453 | (tramp-skeleton-file-name-all-completions filename directory |
| 454 | (all-completions | 454 | (with-parsed-tramp-file-name (expand-file-name directory) nil |
| 455 | filename | 455 | (when (tramp-adb-do-ls v "-a" localname) |
| 456 | (with-parsed-tramp-file-name (expand-file-name directory) nil | 456 | (with-current-buffer (tramp-get-buffer v) |
| 457 | (with-tramp-file-property v localname "file-name-all-completions" | 457 | (mapcar |
| 458 | (when (tramp-adb-do-ls v "-a" localname) | 458 | (lambda (l) |
| 459 | (mapcar | 459 | (and (not (string-match-p (rx bol (* blank) eol) l)) l)) |
| 460 | (lambda (f) | 460 | (split-string (buffer-string) "\n" 'omit))))))) |
| 461 | (if (file-directory-p (expand-file-name f directory)) | ||
| 462 | (file-name-as-directory f) | ||
| 463 | f)) | ||
| 464 | (with-current-buffer (tramp-get-buffer v) | ||
| 465 | (mapcar | ||
| 466 | (lambda (l) | ||
| 467 | (and (not (string-match-p (rx bol (* blank) eol) l)) l)) | ||
| 468 | (split-string (buffer-string) "\n" 'omit)))))))))) | ||
| 469 | 461 | ||
| 470 | (defun tramp-adb-handle-file-local-copy (filename) | 462 | (defun tramp-adb-handle-file-local-copy (filename) |
| 471 | "Like `file-local-copy' for Tramp files." | 463 | "Like `file-local-copy' for Tramp files." |
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 91d9b239a70..fec2e16a624 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el | |||
| @@ -266,7 +266,7 @@ BODY is the backend specific code." | |||
| 266 | tramp--last-hop-directory) | 266 | tramp--last-hop-directory) |
| 267 | tramp-compat-temporary-file-directory)) | 267 | tramp-compat-temporary-file-directory)) |
| 268 | (program (let ((tramp-verbose 0)) | 268 | (program (let ((tramp-verbose 0)) |
| 269 | (tramp-get-method-parameter | 269 | (tramp-expand-args |
| 270 | (make-tramp-file-name :method ,method) | 270 | (make-tramp-file-name :method ,method) |
| 271 | 'tramp-login-program))) | 271 | 'tramp-login-program))) |
| 272 | (vec (when (tramp-tramp-file-p default-directory) | 272 | (vec (when (tramp-tramp-file-p default-directory) |
| @@ -656,10 +656,9 @@ see its function help for a description of the format." | |||
| 656 | '((tramp-config-check . tramp-kubernetes--current-context-data) | 656 | '((tramp-config-check . tramp-kubernetes--current-context-data) |
| 657 | ;; This variable will be eval'ed in `tramp-expand-args'. | 657 | ;; This variable will be eval'ed in `tramp-expand-args'. |
| 658 | (tramp-extra-expand-args | 658 | (tramp-extra-expand-args |
| 659 | . (?a (tramp-kubernetes--container (car tramp-current-connection)) | 659 | ?a (tramp-kubernetes--container (car tramp-current-connection)) |
| 660 | ?h (tramp-kubernetes--pod (car tramp-current-connection)) | 660 | ?h (tramp-kubernetes--pod (car tramp-current-connection)) |
| 661 | ?x (tramp-kubernetes--context-namespace | 661 | ?x (tramp-kubernetes--context-namespace (car tramp-current-connection)))) |
| 662 | (car tramp-current-connection))))) | ||
| 663 | "Default connection-local variables for remote kubernetes connections.") | 662 | "Default connection-local variables for remote kubernetes connections.") |
| 664 | 663 | ||
| 665 | (connection-local-set-profile-variables | 664 | (connection-local-set-profile-variables |
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 59e4cea2edb..4400f4fecd3 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el | |||
| @@ -741,18 +741,16 @@ absolute file names." | |||
| 741 | (defun tramp-crypt-handle-file-name-all-completions (filename directory) | 741 | (defun tramp-crypt-handle-file-name-all-completions (filename directory) |
| 742 | "Like `file-name-all-completions' for Tramp files." | 742 | "Like `file-name-all-completions' for Tramp files." |
| 743 | (tramp-skeleton-file-name-all-completions filename directory | 743 | (tramp-skeleton-file-name-all-completions filename directory |
| 744 | (all-completions | 744 | (let* (completion-regexp-list |
| 745 | filename | 745 | tramp-crypt-enabled |
| 746 | (let* (completion-regexp-list | 746 | (directory (file-name-as-directory directory)) |
| 747 | tramp-crypt-enabled | 747 | (enc-dir (tramp-crypt-encrypt-file-name directory))) |
| 748 | (directory (file-name-as-directory directory)) | 748 | (mapcar |
| 749 | (enc-dir (tramp-crypt-encrypt-file-name directory))) | 749 | (lambda (x) |
| 750 | (mapcar | 750 | (substring |
| 751 | (lambda (x) | 751 | (tramp-crypt-decrypt-file-name (concat enc-dir x)) |
| 752 | (substring | 752 | (length directory))) |
| 753 | (tramp-crypt-decrypt-file-name (concat enc-dir x)) | 753 | (file-name-all-completions "" enc-dir))))) |
| 754 | (length directory))) | ||
| 755 | (file-name-all-completions "" enc-dir)))))) | ||
| 756 | 754 | ||
| 757 | (defun tramp-crypt-handle-file-readable-p (filename) | 755 | (defun tramp-crypt-handle-file-readable-p (filename) |
| 758 | "Like `file-readable-p' for Tramp files." | 756 | "Like `file-readable-p' for Tramp files." |
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 7e140a0e372..601690befd6 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el | |||
| @@ -49,7 +49,7 @@ present for backward compatibility." | |||
| 49 | (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist)) | 49 | (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist)) |
| 50 | (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist))) | 50 | (a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist))) |
| 51 | (setq file-name-handler-alist | 51 | (setq file-name-handler-alist |
| 52 | (delete a1 (delete a2 file-name-handler-alist))))) | 52 | (seq-difference file-name-handler-alist (list a1 a2))))) |
| 53 | 53 | ||
| 54 | (with-eval-after-load 'ange-ftp | 54 | (with-eval-after-load 'ange-ftp |
| 55 | (tramp-disable-ange-ftp)) | 55 | (tramp-disable-ange-ftp)) |
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index b3e59063cd8..f7abddab1a1 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el | |||
| @@ -102,10 +102,7 @@ | |||
| 102 | "Like `file-name-all-completions' for Tramp files." | 102 | "Like `file-name-all-completions' for Tramp files." |
| 103 | (tramp-skeleton-file-name-all-completions filename directory | 103 | (tramp-skeleton-file-name-all-completions filename directory |
| 104 | (tramp-fuse-remove-hidden-files | 104 | (tramp-fuse-remove-hidden-files |
| 105 | (all-completions | 105 | (file-name-all-completions "" (tramp-fuse-local-file-name directory))))) |
| 106 | filename | ||
| 107 | (file-name-all-completions | ||
| 108 | filename (tramp-fuse-local-file-name directory)))))) | ||
| 109 | 106 | ||
| 110 | ;; This function isn't used. | 107 | ;; This function isn't used. |
| 111 | (defun tramp-fuse-handle-insert-directory | 108 | (defun tramp-fuse-handle-insert-directory |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0f68e4d768a..a5919e071c3 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -1479,19 +1479,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." | |||
| 1479 | (defun tramp-gvfs-handle-file-name-all-completions (filename directory) | 1479 | (defun tramp-gvfs-handle-file-name-all-completions (filename directory) |
| 1480 | "Like `file-name-all-completions' for Tramp files." | 1480 | "Like `file-name-all-completions' for Tramp files." |
| 1481 | (tramp-skeleton-file-name-all-completions filename directory | 1481 | (tramp-skeleton-file-name-all-completions filename directory |
| 1482 | (unless (string-search "/" filename) | 1482 | (mapcar #'car (tramp-gvfs-get-directory-attributes directory)))) |
| 1483 | (all-completions | ||
| 1484 | filename | ||
| 1485 | (with-parsed-tramp-file-name (expand-file-name directory) nil | ||
| 1486 | (with-tramp-file-property v localname "file-name-all-completions" | ||
| 1487 | (let (result) | ||
| 1488 | ;; Get a list of directories and files. | ||
| 1489 | (dolist (item | ||
| 1490 | (tramp-gvfs-get-directory-attributes directory) | ||
| 1491 | result) | ||
| 1492 | (if (string-equal (cdr (assoc "type" item)) "directory") | ||
| 1493 | (push (file-name-as-directory (car item)) result) | ||
| 1494 | (push (car item) result)))))))))) | ||
| 1495 | 1483 | ||
| 1496 | (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) | 1484 | (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) |
| 1497 | "Like `file-notify-add-watch' for Tramp files." | 1485 | "Like `file-notify-add-watch' for Tramp files." |
| @@ -1545,11 +1533,13 @@ If FILE-SYSTEM is non-nil, return file system attributes." | |||
| 1545 | (when rest-string | 1533 | (when rest-string |
| 1546 | (tramp-message proc 10 "Previous string:\n%s" rest-string)) | 1534 | (tramp-message proc 10 "Previous string:\n%s" rest-string)) |
| 1547 | (tramp-message proc 6 "%S\n%s" proc string) | 1535 | (tramp-message proc 6 "%S\n%s" proc string) |
| 1548 | (setq string (concat rest-string string) | 1536 | (setq string |
| 1549 | ;; Fix action names. | 1537 | (thread-last |
| 1550 | string (string-replace "attributes changed" "attribute-changed" string) | 1538 | (concat rest-string string) |
| 1551 | string (string-replace "changes done" "changes-done-hint" string) | 1539 | ;; Fix action names. |
| 1552 | string (string-replace "renamed to" "moved" string)) | 1540 | (string-replace "attributes changed" "attribute-changed") |
| 1541 | (string-replace "changes done" "changes-done-hint") | ||
| 1542 | (string-replace "renamed to" "moved"))) | ||
| 1553 | ;; https://bugs.launchpad.net/bugs/1742946 | 1543 | ;; https://bugs.launchpad.net/bugs/1742946 |
| 1554 | (when | 1544 | (when |
| 1555 | (string-match-p | 1545 | (string-match-p |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c83a7a9978d..9aec9e38f65 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -1993,48 +1993,39 @@ ID-FORMAT valid values are `string' and `integer'." | |||
| 1993 | "Like `file-name-all-completions' for Tramp files." | 1993 | "Like `file-name-all-completions' for Tramp files." |
| 1994 | (tramp-skeleton-file-name-all-completions filename directory | 1994 | (tramp-skeleton-file-name-all-completions filename directory |
| 1995 | (with-parsed-tramp-file-name (expand-file-name directory) nil | 1995 | (with-parsed-tramp-file-name (expand-file-name directory) nil |
| 1996 | (when (and (not (string-search "/" filename)) | 1996 | (let (result) |
| 1997 | (tramp-connectable-p v)) | 1997 | ;; Get a list of directories and files, including reliably |
| 1998 | (unless (string-search "/" filename) | 1998 | ;; tagging the directories with a trailing "/". |
| 1999 | (all-completions | 1999 | ;; Because I rock. --daniel@danann.net |
| 2000 | filename | 2000 | (if (tramp-get-remote-perl v) |
| 2001 | (with-tramp-file-property v localname "file-name-all-completions" | 2001 | (tramp-maybe-send-script |
| 2002 | (let (result) | 2002 | v tramp-perl-file-name-all-completions |
| 2003 | ;; Get a list of directories and files, including | 2003 | "tramp_perl_file_name_all_completions") |
| 2004 | ;; reliably tagging the directories with a trailing "/". | 2004 | (tramp-maybe-send-script |
| 2005 | ;; Because I rock. --daniel@danann.net | 2005 | v tramp-shell-file-name-all-completions |
| 2006 | (if (tramp-get-remote-perl v) | 2006 | "tramp_shell_file_name_all_completions")) |
| 2007 | (tramp-maybe-send-script | 2007 | |
| 2008 | v tramp-perl-file-name-all-completions | 2008 | (dolist |
| 2009 | "tramp_perl_file_name_all_completions") | 2009 | (elt |
| 2010 | (tramp-maybe-send-script | 2010 | (tramp-send-command-and-read |
| 2011 | v tramp-shell-file-name-all-completions | 2011 | v (format |
| 2012 | "tramp_shell_file_name_all_completions")) | 2012 | "%s %s" |
| 2013 | 2013 | (if (tramp-get-remote-perl v) | |
| 2014 | (dolist | 2014 | "tramp_perl_file_name_all_completions" |
| 2015 | (elt | 2015 | "tramp_shell_file_name_all_completions") |
| 2016 | (tramp-send-command-and-read | 2016 | (tramp-shell-quote-argument localname)) |
| 2017 | v (format | 2017 | 'noerror) |
| 2018 | "%s %s" | 2018 | result) |
| 2019 | (if (tramp-get-remote-perl v) | 2019 | ;; Don't cache "." and "..". |
| 2020 | "tramp_perl_file_name_all_completions" | 2020 | (when (string-match-p |
| 2021 | "tramp_shell_file_name_all_completions") | 2021 | directory-files-no-dot-files-regexp |
| 2022 | (tramp-shell-quote-argument localname)) | 2022 | (file-name-nondirectory (car elt))) |
| 2023 | 'noerror) | 2023 | (tramp-set-file-property v (car elt) "file-exists-p" (nth 1 elt)) |
| 2024 | result) | 2024 | (tramp-set-file-property v (car elt) "file-readable-p" (nth 2 elt)) |
| 2025 | ;; Don't cache "." and "..". | 2025 | (tramp-set-file-property v (car elt) "file-directory-p" (nth 3 elt)) |
| 2026 | (when (string-match-p | 2026 | (tramp-set-file-property v (car elt) "file-executable-p" (nth 4 elt))) |
| 2027 | directory-files-no-dot-files-regexp | 2027 | |
| 2028 | (file-name-nondirectory (car elt))) | 2028 | (push (file-name-nondirectory (car elt)) result)))))) |
| 2029 | (tramp-set-file-property v (car elt) "file-exists-p" (nth 1 elt)) | ||
| 2030 | (tramp-set-file-property v (car elt) "file-readable-p" (nth 2 elt)) | ||
| 2031 | (tramp-set-file-property v (car elt) "file-directory-p" (nth 3 elt)) | ||
| 2032 | (tramp-set-file-property v (car elt) "file-executable-p" (nth 4 elt))) | ||
| 2033 | |||
| 2034 | (push | ||
| 2035 | (concat | ||
| 2036 | (file-name-nondirectory (car elt)) (and (nth 3 elt) "/")) | ||
| 2037 | result)))))))))) | ||
| 2038 | 2029 | ||
| 2039 | ;; cp, mv and ln | 2030 | ;; cp, mv and ln |
| 2040 | 2031 | ||
| @@ -2803,7 +2794,7 @@ The method used must be an out-of-band method." | |||
| 2803 | (append switches (split-string (tramp-sh--quoting-style-options v)) | 2794 | (append switches (split-string (tramp-sh--quoting-style-options v)) |
| 2804 | (when dired `(,dired)))) | 2795 | (when dired `(,dired)))) |
| 2805 | (unless dired | 2796 | (unless dired |
| 2806 | (setq switches (delete "-N" (delete "--dired" switches))))) | 2797 | (setq switches (seq-difference switches '("-N" "--dired"))))) |
| 2807 | (when wildcard | 2798 | (when wildcard |
| 2808 | (setq wildcard (tramp-run-real-handler | 2799 | (setq wildcard (tramp-run-real-handler |
| 2809 | #'file-name-nondirectory (list localname))) | 2800 | #'file-name-nondirectory (list localname))) |
| @@ -3917,11 +3908,13 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3917 | (when rest-string | 3908 | (when rest-string |
| 3918 | (tramp-message proc 10 "Previous string:\n%s" rest-string)) | 3909 | (tramp-message proc 10 "Previous string:\n%s" rest-string)) |
| 3919 | (tramp-message proc 6 "%S\n%s" proc string) | 3910 | (tramp-message proc 6 "%S\n%s" proc string) |
| 3920 | (setq string (concat rest-string string) | 3911 | (setq string |
| 3921 | ;; Fix action names. | 3912 | (thread-last |
| 3922 | string (string-replace "attributes changed" "attribute-changed" string) | 3913 | (concat rest-string string) |
| 3923 | string (string-replace "changes done" "changes-done-hint" string) | 3914 | ;; Fix action names. |
| 3924 | string (string-replace "renamed to" "moved" string)) | 3915 | (string-replace "attributes changed" "attribute-changed") |
| 3916 | (string-replace "changes done" "changes-done-hint") | ||
| 3917 | (string-replace "renamed to" "moved"))) | ||
| 3925 | 3918 | ||
| 3926 | (catch 'doesnt-work | 3919 | (catch 'doesnt-work |
| 3927 | ;; https://bugs.launchpad.net/bugs/1742946 | 3920 | ;; https://bugs.launchpad.net/bugs/1742946 |
| @@ -5044,7 +5037,7 @@ Goes through the list `tramp-inline-compress-commands'." | |||
| 5044 | ;; Use plink options. | 5037 | ;; Use plink options. |
| 5045 | ((string-match-p | 5038 | ((string-match-p |
| 5046 | (rx "plink" (? ".exe") eol) | 5039 | (rx "plink" (? ".exe") eol) |
| 5047 | (tramp-get-method-parameter vec 'tramp-login-program)) | 5040 | (tramp-expand-args vec 'tramp-login-program)) |
| 5048 | (concat | 5041 | (concat |
| 5049 | (if (eq tramp-use-connection-share 'suppress) | 5042 | (if (eq tramp-use-connection-share 'suppress) |
| 5050 | "-noshare" "-share") | 5043 | "-noshare" "-share") |
| @@ -5405,7 +5398,7 @@ connection if a previous connection has died for some reason." | |||
| 5405 | hop 'tramp-connection-timeout | 5398 | hop 'tramp-connection-timeout |
| 5406 | tramp-connection-timeout)) | 5399 | tramp-connection-timeout)) |
| 5407 | (command | 5400 | (command |
| 5408 | (tramp-get-method-parameter | 5401 | (tramp-expand-args |
| 5409 | hop 'tramp-login-program)) | 5402 | hop 'tramp-login-program)) |
| 5410 | ;; We don't create the temporary file. In | 5403 | ;; We don't create the temporary file. In |
| 5411 | ;; fact, it is just a prefix for the | 5404 | ;; fact, it is just a prefix for the |
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 554aa354c00..8eec0e1bd08 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el | |||
| @@ -603,12 +603,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 603 | (copy-directory filename newname keep-date 'parents 'copy-contents) | 603 | (copy-directory filename newname keep-date 'parents 'copy-contents) |
| 604 | 604 | ||
| 605 | (tramp-barf-if-file-missing v filename | 605 | (tramp-barf-if-file-missing v filename |
| 606 | ;; `file-local-copy' returns a file name also for a local | 606 | ;; Suppress `jka-compr-handler'. |
| 607 | ;; file with `jka-compr-handler', so we cannot trust its | 607 | (if-let* ((jka-compr-inhibit t) |
| 608 | ;; result as indication for a remote file name. | 608 | (tmpfile (file-local-copy filename))) |
| 609 | (if-let* ((tmpfile | ||
| 610 | (and (tramp-tramp-file-p filename) | ||
| 611 | (file-local-copy filename)))) | ||
| 612 | ;; Remote filename. | 609 | ;; Remote filename. |
| 613 | (condition-case err | 610 | (condition-case err |
| 614 | (rename-file tmpfile newname ok-if-already-exists) | 611 | (rename-file tmpfile newname ok-if-already-exists) |
| @@ -1068,18 +1065,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 1068 | (defun tramp-smb-handle-file-name-all-completions (filename directory) | 1065 | (defun tramp-smb-handle-file-name-all-completions (filename directory) |
| 1069 | "Like `file-name-all-completions' for Tramp files." | 1066 | "Like `file-name-all-completions' for Tramp files." |
| 1070 | (tramp-skeleton-file-name-all-completions filename directory | 1067 | (tramp-skeleton-file-name-all-completions filename directory |
| 1071 | (all-completions | 1068 | (mapcar #'car (tramp-smb-get-file-entries directory)))) |
| 1072 | filename | ||
| 1073 | (when (file-directory-p directory) | ||
| 1074 | (with-parsed-tramp-file-name (expand-file-name directory) nil | ||
| 1075 | (with-tramp-file-property v localname "file-name-all-completions" | ||
| 1076 | (mapcar | ||
| 1077 | (lambda (x) | ||
| 1078 | (list | ||
| 1079 | (if (string-search "d" (nth 1 x)) | ||
| 1080 | (file-name-as-directory (nth 0 x)) | ||
| 1081 | (nth 0 x)))) | ||
| 1082 | (tramp-smb-get-file-entries directory)))))))) | ||
| 1083 | 1069 | ||
| 1084 | (defun tramp-smb-handle-file-system-info (filename) | 1070 | (defun tramp-smb-handle-file-system-info (filename) |
| 1085 | "Like `file-system-info' for Tramp files." | 1071 | "Like `file-system-info' for Tramp files." |
| @@ -1752,9 +1738,6 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." | |||
| 1752 | (unless share | 1738 | (unless share |
| 1753 | (tramp-set-connection-property v "share-cache" res))) | 1739 | (tramp-set-connection-property v "share-cache" res))) |
| 1754 | 1740 | ||
| 1755 | ;; Add directory itself. | ||
| 1756 | (push '("" "drwxrwxrwx" 0 (0 0)) res) | ||
| 1757 | |||
| 1758 | ;; Return entries. | 1741 | ;; Return entries. |
| 1759 | (delq nil res))))) | 1742 | (delq nil res))))) |
| 1760 | 1743 | ||
| @@ -2295,9 +2278,6 @@ SHARE will be passed to the call of `tramp-smb-get-localname'." | |||
| 2295 | 2278 | ||
| 2296 | ;; * Return more comprehensive file permission string. | 2279 | ;; * Return more comprehensive file permission string. |
| 2297 | ;; | 2280 | ;; |
| 2298 | ;; * Try to remove the inclusion of dummy "" directory. Seems to be at | ||
| 2299 | ;; several places, especially in `tramp-smb-handle-insert-directory'. | ||
| 2300 | ;; | ||
| 2301 | ;; * Keep a separate connection process per share. | 2281 | ;; * Keep a separate connection process per share. |
| 2302 | ;; | 2282 | ;; |
| 2303 | ;; * Keep a permanent connection process for `process-file'. | 2283 | ;; * Keep a permanent connection process for `process-file'. |
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 2cb5b5b1ed1..f4073158683 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el | |||
| @@ -269,7 +269,7 @@ arguments to pass to the OPERATION." | |||
| 269 | (setq ret | 269 | (setq ret |
| 270 | (apply | 270 | (apply |
| 271 | #'tramp-call-process | 271 | #'tramp-call-process |
| 272 | v (tramp-get-method-parameter v 'tramp-login-program) | 272 | v (tramp-expand-args v 'tramp-login-program) |
| 273 | nil outbuf display | 273 | nil outbuf display |
| 274 | (tramp-expand-args | 274 | (tramp-expand-args |
| 275 | v 'tramp-login-args nil | 275 | v 'tramp-login-args nil |
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 9511c899b2b..8bf6a9f50b0 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el | |||
| @@ -498,24 +498,16 @@ the result will be a local, non-Tramp, file name." | |||
| 498 | (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) | 498 | (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) |
| 499 | "Like `file-name-all-completions' for Tramp files." | 499 | "Like `file-name-all-completions' for Tramp files." |
| 500 | (tramp-skeleton-file-name-all-completions filename directory | 500 | (tramp-skeleton-file-name-all-completions filename directory |
| 501 | (all-completions | 501 | (with-parsed-tramp-file-name (expand-file-name directory) nil |
| 502 | filename | 502 | (tramp-sudoedit-send-command |
| 503 | (with-parsed-tramp-file-name (expand-file-name directory) nil | 503 | v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" |
| 504 | (with-tramp-file-property v localname "file-name-all-completions" | 504 | (if (tramp-string-empty-or-nil-p localname) |
| 505 | (tramp-sudoedit-send-command | 505 | "" (file-name-unquote localname))) |
| 506 | v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" | 506 | (mapcar |
| 507 | (if (tramp-string-empty-or-nil-p localname) | 507 | (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) |
| 508 | "" (file-name-unquote localname))) | 508 | (split-string |
| 509 | (mapcar | 509 | (tramp-get-buffer-string (tramp-get-connection-buffer v)) |
| 510 | (lambda (f) | 510 | "\n" 'omit))))) |
| 511 | (if (ignore-errors (file-directory-p (expand-file-name f directory))) | ||
| 512 | (file-name-as-directory f) | ||
| 513 | f)) | ||
| 514 | (mapcar | ||
| 515 | (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) | ||
| 516 | (split-string | ||
| 517 | (tramp-get-buffer-string (tramp-get-connection-buffer v)) | ||
| 518 | "\n" 'omit)))))))) | ||
| 519 | 511 | ||
| 520 | (defun tramp-sudoedit-handle-file-readable-p (filename) | 512 | (defun tramp-sudoedit-handle-file-readable-p (filename) |
| 521 | "Like `file-readable-p' for Tramp files." | 513 | "Like `file-readable-p' for Tramp files." |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5441a26d7a0..03089dffb55 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -2002,12 +2002,11 @@ expected to be a string, which will be used." | |||
| 2002 | "Construct a Tramp hop name from VEC." | 2002 | "Construct a Tramp hop name from VEC." |
| 2003 | (concat | 2003 | (concat |
| 2004 | (tramp-file-name-hop vec) | 2004 | (tramp-file-name-hop vec) |
| 2005 | (replace-regexp-in-string | 2005 | (thread-last |
| 2006 | tramp-prefix-regexp "" | 2006 | (replace-regexp-in-string |
| 2007 | (replace-regexp-in-string | 2007 | (rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format |
| 2008 | (rx (regexp tramp-postfix-host-regexp) eos) | 2008 | (tramp-make-tramp-file-name (tramp-file-name-unify vec))) |
| 2009 | tramp-postfix-hop-format | 2009 | (replace-regexp-in-string tramp-prefix-regexp "")))) |
| 2010 | (tramp-make-tramp-file-name (tramp-file-name-unify vec)))))) | ||
| 2011 | 2010 | ||
| 2012 | (defun tramp-completion-make-tramp-file-name (method user host localname) | 2011 | (defun tramp-completion-make-tramp-file-name (method user host localname) |
| 2013 | "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME. | 2012 | "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME. |
| @@ -2957,7 +2956,7 @@ not in completion mode." | |||
| 2957 | (or (and (cond | 2956 | (or (and (cond |
| 2958 | ;; Completion styles like `flex' and `substring' check for | 2957 | ;; Completion styles like `flex' and `substring' check for |
| 2959 | ;; the file name "/". This does exist. | 2958 | ;; the file name "/". This does exist. |
| 2960 | ((string-equal filename "/")) | 2959 | ((string-equal filename tramp-prefix-format)) |
| 2961 | ;; Is it a valid method? | 2960 | ;; Is it a valid method? |
| 2962 | ((and (not (string-empty-p tramp-postfix-method-format)) | 2961 | ((and (not (string-empty-p tramp-postfix-method-format)) |
| 2963 | (string-match | 2962 | (string-match |
| @@ -3001,30 +3000,59 @@ not in completion mode." | |||
| 3001 | 3000 | ||
| 3002 | (tramp-run-real-handler #'file-exists-p (list filename)))) | 3001 | (tramp-run-real-handler #'file-exists-p (list filename)))) |
| 3003 | 3002 | ||
| 3003 | (defvar tramp-fnac-add-trailing-slash t | ||
| 3004 | "Whether `file-name-all-completions' shall add a trailing slash. | ||
| 3005 | This is not desired, if that function is used in `directory-files', or | ||
| 3006 | in `tramp-completion-handle-file-name-all-completions'.") | ||
| 3007 | |||
| 3004 | (defmacro tramp-skeleton-file-name-all-completions | 3008 | (defmacro tramp-skeleton-file-name-all-completions |
| 3005 | (filename directory &rest body) | 3009 | (filename directory &rest body) |
| 3006 | "Skeleton for `tramp-*-handle-filename-all-completions'. | 3010 | "Skeleton for `tramp-*-handle-filename-all-completions'. |
| 3007 | BODY is the backend specific code." | 3011 | BODY is the backend specific code." |
| 3008 | (declare (indent 2) (debug t)) | 3012 | (declare (indent 2) (debug t)) |
| 3009 | `(ignore-error file-missing | 3013 | `(ignore-error file-missing |
| 3010 | (seq-uniq (delq nil (delete "" | 3014 | (all-completions |
| 3011 | (let* ((case-fold-search read-file-name-completion-ignore-case) | 3015 | ,filename |
| 3012 | (result (progn ,@body))) | 3016 | (when (file-directory-p ,directory) |
| 3013 | ;; Some storage systems do not return "." and "..". | 3017 | (seq-uniq (delq nil |
| 3014 | (when (tramp-tramp-file-p ,directory) | 3018 | (let* ((case-fold-search read-file-name-completion-ignore-case) |
| 3015 | (dolist (elt '(".." ".")) | 3019 | (result |
| 3016 | (when (string-prefix-p ,filename elt) | 3020 | (if (tramp-tramp-file-p ,directory) |
| 3017 | (setq result (cons (concat elt "/") result))))) | 3021 | (with-parsed-tramp-file-name |
| 3018 | (if (consp completion-regexp-list) | 3022 | (expand-file-name ,directory) nil |
| 3019 | ;; Discriminate over `completion-regexp-list'. | 3023 | (when (and (not (string-search "/" ,filename)) |
| 3020 | (mapcar | 3024 | (tramp-connectable-p v)) |
| 3021 | (lambda (x) | 3025 | (with-tramp-file-property |
| 3022 | (when (stringp x) | 3026 | v localname |
| 3023 | (catch 'match | 3027 | (format |
| 3024 | (dolist (elt completion-regexp-list x) | 3028 | "file-name-all-completions-%s" |
| 3025 | (unless (string-match-p elt x) (throw 'match nil)))))) | 3029 | tramp-fnac-add-trailing-slash) |
| 3026 | result) | 3030 | ;; Mark symlinked directories. Other |
| 3027 | result))))))) | 3031 | ;; directories are already marked. |
| 3032 | (mapcar | ||
| 3033 | (lambda (x) | ||
| 3034 | (let ((f (file-name-concat ,directory x))) | ||
| 3035 | (if (and tramp-fnac-add-trailing-slash | ||
| 3036 | (not (string-suffix-p "/" x)) | ||
| 3037 | (file-directory-p | ||
| 3038 | (if (file-symlink-p f) | ||
| 3039 | (file-truename f) f))) | ||
| 3040 | (concat x "/") x))) | ||
| 3041 | ;; Some storage systems do not return "." and "..". | ||
| 3042 | (seq-union | ||
| 3043 | (seq-difference (progn ,@body) '("." "..")) | ||
| 3044 | '("./" "../")))))) | ||
| 3045 | ,@body))) | ||
| 3046 | ;; Discriminate over `completion-regexp-list'. | ||
| 3047 | (if (consp completion-regexp-list) | ||
| 3048 | (mapcar | ||
| 3049 | (lambda (x) | ||
| 3050 | (when (stringp x) | ||
| 3051 | (catch 'match | ||
| 3052 | (dolist (elt completion-regexp-list x) | ||
| 3053 | (unless (string-match-p elt x) (throw 'match nil)))))) | ||
| 3054 | result) | ||
| 3055 | result)))))))) | ||
| 3028 | 3056 | ||
| 3029 | (defvar tramp--last-hop-directory nil | 3057 | (defvar tramp--last-hop-directory nil |
| 3030 | "Tracks the directory from which to run login programs.") | 3058 | "Tracks the directory from which to run login programs.") |
| @@ -3035,72 +3063,74 @@ BODY is the backend specific code." | |||
| 3035 | ;; completions. | 3063 | ;; completions. |
| 3036 | (defun tramp-completion-handle-file-name-all-completions (filename directory) | 3064 | (defun tramp-completion-handle-file-name-all-completions (filename directory) |
| 3037 | "Like `file-name-all-completions' for partial Tramp files." | 3065 | "Like `file-name-all-completions' for partial Tramp files." |
| 3038 | (tramp-skeleton-file-name-all-completions filename directory | 3066 | (let (tramp-fnac-add-trailing-slash) |
| 3039 | (let ((fullname | 3067 | (tramp-skeleton-file-name-all-completions filename directory |
| 3040 | (tramp-drop-volume-letter (expand-file-name filename directory))) | 3068 | (let ((fullname |
| 3041 | (directory (tramp-drop-volume-letter directory)) | 3069 | (tramp-drop-volume-letter (expand-file-name filename directory))) |
| 3042 | tramp--last-hop-directory hop result result1) | 3070 | (directory (tramp-drop-volume-letter directory)) |
| 3071 | tramp--last-hop-directory hop result result1) | ||
| 3072 | |||
| 3073 | ;; Suppress hop from completion. | ||
| 3074 | (when (string-match | ||
| 3075 | (rx | ||
| 3076 | (regexp tramp-prefix-regexp) | ||
| 3077 | (group (+ (regexp tramp-remote-file-name-spec-regexp) | ||
| 3078 | (regexp tramp-postfix-hop-regexp)))) | ||
| 3079 | fullname) | ||
| 3080 | (setq hop (match-string 1 fullname) | ||
| 3081 | fullname (replace-match "" nil nil fullname 1) | ||
| 3082 | tramp--last-hop-directory | ||
| 3083 | (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) | ||
| 3084 | |||
| 3085 | (let (tramp-default-user tramp-default-user-alist | ||
| 3086 | tramp-default-host tramp-default-host-alist) | ||
| 3087 | |||
| 3088 | ;; Possible completion structures. | ||
| 3089 | (dolist (elt (tramp-completion-dissect-file-name fullname)) | ||
| 3090 | (let* ((method (tramp-file-name-method elt)) | ||
| 3091 | (user (tramp-file-name-user elt)) | ||
| 3092 | (host (tramp-file-name-host elt)) | ||
| 3093 | (localname (tramp-file-name-localname elt)) | ||
| 3094 | (m (tramp-find-method method user host)) | ||
| 3095 | all-user-hosts) | ||
| 3096 | |||
| 3097 | (unless localname ;; Nothing to complete. | ||
| 3098 | (if (or user host) | ||
| 3099 | ;; Method dependent user / host combinations. | ||
| 3100 | (progn | ||
| 3101 | (mapc | ||
| 3102 | (lambda (x) | ||
| 3103 | (setq all-user-hosts | ||
| 3104 | (append all-user-hosts | ||
| 3105 | (funcall (nth 0 x) (nth 1 x))))) | ||
| 3106 | (tramp-get-completion-function m)) | ||
| 3043 | 3107 | ||
| 3044 | ;; Suppress hop from completion. | 3108 | (setq result |
| 3045 | (when (string-match | 3109 | (append result |
| 3046 | (rx | 3110 | (mapcar |
| 3047 | (regexp tramp-prefix-regexp) | 3111 | (lambda (x) |
| 3048 | (group (+ (regexp tramp-remote-file-name-spec-regexp) | 3112 | (tramp-get-completion-user-host |
| 3049 | (regexp tramp-postfix-hop-regexp)))) | 3113 | method user host (nth 0 x) (nth 1 x))) |
| 3050 | fullname) | 3114 | all-user-hosts)))) |
| 3051 | (setq hop (match-string 1 fullname) | 3115 | |
| 3052 | fullname (replace-match "" nil nil fullname 1) | 3116 | ;; Possible methods. |
| 3053 | tramp--last-hop-directory | 3117 | (setq result |
| 3054 | (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) | 3118 | (append result (tramp-get-completion-methods m hop))))))) |
| 3055 | 3119 | ||
| 3056 | (let (tramp-default-user tramp-default-user-alist | 3120 | ;; Add hop. |
| 3057 | tramp-default-host tramp-default-host-alist) | 3121 | (dolist (elt result) |
| 3058 | 3122 | (when elt | |
| 3059 | ;; Possible completion structures. | 3123 | (setq elt (replace-regexp-in-string |
| 3060 | (dolist (elt (tramp-completion-dissect-file-name fullname)) | 3124 | tramp-prefix-regexp |
| 3061 | (let* ((method (tramp-file-name-method elt)) | 3125 | (concat tramp-prefix-format hop) elt)) |
| 3062 | (user (tramp-file-name-user elt)) | 3126 | (push (substring elt (length directory)) result1))) |
| 3063 | (host (tramp-file-name-host elt)) | 3127 | |
| 3064 | (localname (tramp-file-name-localname elt)) | 3128 | ;; Complete local parts. |
| 3065 | (m (tramp-find-method method user host)) | 3129 | (append |
| 3066 | all-user-hosts) | 3130 | result1 |
| 3067 | 3131 | (ignore-errors | |
| 3068 | (unless localname ;; Nothing to complete. | 3132 | (tramp-run-real-handler |
| 3069 | (if (or user host) | 3133 | #'file-name-all-completions (list filename directory))))))))) |
| 3070 | ;; Method dependent user / host combinations. | ||
| 3071 | (progn | ||
| 3072 | (mapc | ||
| 3073 | (lambda (x) | ||
| 3074 | (setq all-user-hosts | ||
| 3075 | (append all-user-hosts | ||
| 3076 | (funcall (nth 0 x) (nth 1 x))))) | ||
| 3077 | (tramp-get-completion-function m)) | ||
| 3078 | |||
| 3079 | (setq result | ||
| 3080 | (append result | ||
| 3081 | (mapcar | ||
| 3082 | (lambda (x) | ||
| 3083 | (tramp-get-completion-user-host | ||
| 3084 | method user host (nth 0 x) (nth 1 x))) | ||
| 3085 | all-user-hosts)))) | ||
| 3086 | |||
| 3087 | ;; Possible methods. | ||
| 3088 | (setq result | ||
| 3089 | (append result (tramp-get-completion-methods m hop))))))) | ||
| 3090 | |||
| 3091 | ;; Add hop. | ||
| 3092 | (dolist (elt result) | ||
| 3093 | (when elt | ||
| 3094 | (setq elt (replace-regexp-in-string | ||
| 3095 | tramp-prefix-regexp (concat tramp-prefix-format hop) elt)) | ||
| 3096 | (push (substring elt (length directory)) result1))) | ||
| 3097 | |||
| 3098 | ;; Complete local parts. | ||
| 3099 | (append | ||
| 3100 | result1 | ||
| 3101 | (ignore-errors | ||
| 3102 | (tramp-run-real-handler | ||
| 3103 | #'file-name-all-completions (list filename directory)))))))) | ||
| 3104 | 3134 | ||
| 3105 | ;; Method, host name and user name completion for a file. | 3135 | ;; Method, host name and user name completion for a file. |
| 3106 | (defun tramp-completion-handle-file-name-completion | 3136 | (defun tramp-completion-handle-file-name-completion |
| @@ -3659,9 +3689,10 @@ BODY is the backend specific code." | |||
| 3659 | (signal 'error nil) | 3689 | (signal 'error nil) |
| 3660 | (setf ,directory | 3690 | (setf ,directory |
| 3661 | (file-name-as-directory (expand-file-name ,directory))) | 3691 | (file-name-as-directory (expand-file-name ,directory))) |
| 3662 | (let ((temp | 3692 | (let* (tramp-fnac-add-trailing-slash |
| 3663 | (with-tramp-file-property v localname "directory-files" ,@body)) | 3693 | (temp |
| 3664 | result item) | 3694 | (with-tramp-file-property v localname "directory-files" ,@body)) |
| 3695 | result item) | ||
| 3665 | (while temp | 3696 | (while temp |
| 3666 | (setq item (directory-file-name (pop temp))) | 3697 | (setq item (directory-file-name (pop temp))) |
| 3667 | (when (or (null ,match) (string-match-p ,match item)) | 3698 | (when (or (null ,match) (string-match-p ,match item)) |
| @@ -4496,8 +4527,8 @@ Let-bind it when necessary.") | |||
| 4496 | ;; "." and ".." are never interesting as completions, and are | 4527 | ;; "." and ".." are never interesting as completions, and are |
| 4497 | ;; actually in the way in a directory with only one file. See | 4528 | ;; actually in the way in a directory with only one file. See |
| 4498 | ;; file_name_completion() in dired.c. | 4529 | ;; file_name_completion() in dired.c. |
| 4499 | (when (and (consp fnac) (length= (delete "./" (delete "../" fnac)) 1)) | 4530 | (when (and (consp fnac) (length= (seq-difference fnac '("./" "../")) 1)) |
| 4500 | (setq fnac (delete "./" (delete "../" fnac)))) | 4531 | (setq fnac (seq-difference fnac '("./" "../")))) |
| 4501 | (or | 4532 | (or |
| 4502 | (try-completion | 4533 | (try-completion |
| 4503 | filename fnac | 4534 | filename fnac |
| @@ -5294,7 +5325,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") | |||
| 5294 | (defvar tramp-extra-expand-args nil | 5325 | (defvar tramp-extra-expand-args nil |
| 5295 | "Method specific arguments.") | 5326 | "Method specific arguments.") |
| 5296 | 5327 | ||
| 5297 | (defun tramp-expand-args (vec parameter default &rest spec-list) | 5328 | (defun tramp-expand-args (vec parameter &optional default &rest spec-list) |
| 5298 | "Expand login arguments as given by PARAMETER in `tramp-methods'. | 5329 | "Expand login arguments as given by PARAMETER in `tramp-methods'. |
| 5299 | PARAMETER is a symbol like `tramp-login-args', denoting a list of | 5330 | PARAMETER is a symbol like `tramp-login-args', denoting a list of |
| 5300 | list of strings from `tramp-methods', containing %-sequences for | 5331 | list of strings from `tramp-methods', containing %-sequences for |
| @@ -5317,12 +5348,15 @@ a connection-local variable." | |||
| 5317 | (setq spec-list (cddr spec-list))) | 5348 | (setq spec-list (cddr spec-list))) |
| 5318 | (setq spec (apply #'format-spec-make extra-spec-list)) | 5349 | (setq spec (apply #'format-spec-make extra-spec-list)) |
| 5319 | ;; Expand format spec. | 5350 | ;; Expand format spec. |
| 5320 | (flatten-tree | 5351 | (cond |
| 5321 | (mapcar | 5352 | ((consp args) |
| 5322 | (lambda (x) | 5353 | (flatten-tree |
| 5323 | (setq x (mapcar (lambda (y) (tramp-format-spec y spec)) x)) | 5354 | (mapcar |
| 5324 | (unless (member "" x) x)) | 5355 | (lambda (x) |
| 5325 | args)))) | 5356 | (setq x (mapcar (lambda (y) (tramp-format-spec y spec)) x)) |
| 5357 | (unless (member "" x) x)) | ||
| 5358 | args))) | ||
| 5359 | (args (tramp-format-spec args spec))))) | ||
| 5326 | 5360 | ||
| 5327 | (defun tramp-post-process-creation (proc vec) | 5361 | (defun tramp-post-process-creation (proc vec) |
| 5328 | "Apply actions after creation of process PROC." | 5362 | "Apply actions after creation of process PROC." |
| @@ -5444,8 +5478,7 @@ processes." | |||
| 5444 | (tramp-get-method-parameter v 'tramp-direct-async) | 5478 | (tramp-get-method-parameter v 'tramp-direct-async) |
| 5445 | `(,(string-join command " "))) | 5479 | `(,(string-join command " "))) |
| 5446 | command)) | 5480 | command)) |
| 5447 | (login-program | 5481 | (login-program (tramp-expand-args v 'tramp-login-program)) |
| 5448 | (tramp-get-method-parameter v 'tramp-login-program)) | ||
| 5449 | ;; We don't create the temporary file. In fact, it is just | 5482 | ;; We don't create the temporary file. In fact, it is just |
| 5450 | ;; a prefix for the ControlPath option of ssh; the real | 5483 | ;; a prefix for the ControlPath option of ssh; the real |
| 5451 | ;; temporary file has another name, and it is created and | 5484 | ;; temporary file has another name, and it is created and |
| @@ -5487,7 +5520,7 @@ processes." | |||
| 5487 | v 'tramp-login-args nil | 5520 | v 'tramp-login-args nil |
| 5488 | ?h (or host "") ?u (or user "") ?p (or port "") | 5521 | ?h (or host "") ?u (or user "") ?p (or port "") |
| 5489 | ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) | 5522 | ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) |
| 5490 | ?d (or device "") ?a (or pta "") ?l "")))) | 5523 | ?w "" ?d (or device "") ?a (or pta "") ?l "")))) |
| 5491 | ;; Suppress `internal-default-process-sentinel', which is set | 5524 | ;; Suppress `internal-default-process-sentinel', which is set |
| 5492 | ;; when :sentinel is nil. (Bug#71049) | 5525 | ;; when :sentinel is nil. (Bug#71049) |
| 5493 | p (make-process | 5526 | p (make-process |
diff --git a/lisp/obsolete/linum.el b/lisp/obsolete/linum.el index 5a0a67ebff0..9b0efaf223a 100644 --- a/lisp/obsolete/linum.el +++ b/lisp/obsolete/linum.el | |||
| @@ -129,6 +129,7 @@ Linum mode is a buffer-local minor mode." | |||
| 129 | ;; Note that nowadays, this actually doesn't show line | 129 | ;; Note that nowadays, this actually doesn't show line |
| 130 | ;; numbers in client frames at all, because we visit the | 130 | ;; numbers in client frames at all, because we visit the |
| 131 | ;; file before creating the client frame. See bug#35726. | 131 | ;; file before creating the client frame. See bug#35726. |
| 132 | ;; Use `frame-initial-p'? | ||
| 132 | (and (daemonp) (eq (selected-frame) terminal-frame))) | 133 | (and (daemonp) (eq (selected-frame) terminal-frame))) |
| 133 | (linum-mode 1))) | 134 | (linum-mode 1))) |
| 134 | 135 | ||
diff --git a/lisp/outline.el b/lisp/outline.el index 4fb953b0f7c..ea66ee5c8e9 100644 --- a/lisp/outline.el +++ b/lisp/outline.el | |||
| @@ -326,10 +326,10 @@ non-nil and point is located on the heading line.") | |||
| 326 | (defcustom outline-minor-mode-use-buttons nil | 326 | (defcustom outline-minor-mode-use-buttons nil |
| 327 | "Whether to display clickable buttons on the headings. | 327 | "Whether to display clickable buttons on the headings. |
| 328 | These buttons can be used to hide and show the body under the heading. | 328 | These buttons can be used to hide and show the body under the heading. |
| 329 | When the value is `insert', additional placeholders for buttons are | 329 | When the value is \\+`insert', additional placeholders for buttons are |
| 330 | inserted to the buffer, so buttons are not only clickable, | 330 | inserted to the buffer, so buttons are not only clickable, |
| 331 | but also typing `RET' on them can hide and show the body. | 331 | but also typing `RET' on them can hide and show the body. |
| 332 | Using the value `insert' is not recommended in editable | 332 | Using the value \\+`insert' is not recommended in editable |
| 333 | buffers because it modifies them. | 333 | buffers because it modifies them. |
| 334 | When the value is `in-margins', then clickable buttons are | 334 | When the value is `in-margins', then clickable buttons are |
| 335 | displayed in the margins before the headings. | 335 | displayed in the margins before the headings. |
| @@ -513,7 +513,7 @@ font-lock faces defined by the major mode. Thus, a non-nil value will | |||
| 513 | work well only when there's no such conflict. | 513 | work well only when there's no such conflict. |
| 514 | If the value is t, use outline faces only if there are no major mode's | 514 | If the value is t, use outline faces only if there are no major mode's |
| 515 | font-lock faces on headings. When `override', completely overwrite major | 515 | font-lock faces on headings. When `override', completely overwrite major |
| 516 | mode's font-lock faces with outline faces. When `append', try to append | 516 | mode's font-lock faces with outline faces. When \\+`append', try to append |
| 517 | outline font-lock faces to those of major mode." | 517 | outline font-lock faces to those of major mode." |
| 518 | :type '(choice (const :tag "Do not use outline font-lock highlighting" nil) | 518 | :type '(choice (const :tag "Do not use outline font-lock highlighting" nil) |
| 519 | (const :tag "Overwrite major mode font-lock faces" override) | 519 | (const :tag "Overwrite major mode font-lock faces" override) |
diff --git a/lisp/paren.el b/lisp/paren.el index 1ab3f9a32cf..10c72dadc79 100644 --- a/lisp/paren.el +++ b/lisp/paren.el | |||
| @@ -434,9 +434,10 @@ It is the default value of `show-paren-data-function'." | |||
| 434 | (overlay-put show-paren--context-overlay 'priority | 434 | (overlay-put show-paren--context-overlay 'priority |
| 435 | show-paren-priority) | 435 | show-paren-priority) |
| 436 | (overlay-put show-paren--context-overlay | 436 | (overlay-put show-paren--context-overlay |
| 437 | 'face `(:box | 437 | 'face `( :inherit default |
| 438 | ( :line-width (1 . -1) | 438 | :box |
| 439 | :color ,(face-attribute 'shadow :foreground)))) | 439 | ( :line-width (1 . -1) |
| 440 | :color ,(face-attribute 'shadow :foreground)))) | ||
| 440 | (add-hook 'post-command-hook #'show-paren--delete-context-overlay | 441 | (add-hook 'post-command-hook #'show-paren--delete-context-overlay |
| 441 | nil 'local)) | 442 | nil 'local)) |
| 442 | 443 | ||
diff --git a/lisp/printing.el b/lisp/printing.el index b6be982f5cb..3f31472d176 100644 --- a/lisp/printing.el +++ b/lisp/printing.el | |||
| @@ -1431,7 +1431,7 @@ COMMAND Name of the program for printing a text file. On MS-DOS and | |||
| 1431 | specially, using NAME as the destination for output; any other | 1431 | specially, using NAME as the destination for output; any other |
| 1432 | program is treated like `lpr' except that an explicit filename | 1432 | program is treated like `lpr' except that an explicit filename |
| 1433 | is given as the last argument. | 1433 | is given as the last argument. |
| 1434 | If COMMAND is nil, it's used the default printing program: | 1434 | If COMMAND is nil, it stands for the default printing program: |
| 1435 | `print' for Windows system, `lp' for lp system and `lpr' for | 1435 | `print' for Windows system, `lp' for lp system and `lpr' for |
| 1436 | all other systems. See also `pr-path-alist'. | 1436 | all other systems. See also `pr-path-alist'. |
| 1437 | Examples: | 1437 | Examples: |
| @@ -1506,7 +1506,10 @@ Useful links: | |||
| 1506 | :type '(repeat | 1506 | :type '(repeat |
| 1507 | (list :tag "Text Printer" | 1507 | (list :tag "Text Printer" |
| 1508 | (symbol :tag "Printer Symbol Name") | 1508 | (symbol :tag "Printer Symbol Name") |
| 1509 | (string :tag "Printer Command") | 1509 | (choice :menu-tag "Printer Command" |
| 1510 | :tag "Printer Command" | ||
| 1511 | (const :tag "Default print command" nil) | ||
| 1512 | (string :tag "Explicit print command")) | ||
| 1510 | (repeat :tag "Printer Switches" | 1513 | (repeat :tag "Printer Switches" |
| 1511 | (sexp :tag "Switch" :value "")) | 1514 | (sexp :tag "Switch" :value "")) |
| 1512 | (choice :menu-tag "Printer Name" | 1515 | (choice :menu-tag "Printer Name" |
| @@ -1577,7 +1580,7 @@ COMMAND Name of the program for printing a PostScript file. On MS-DOS | |||
| 1577 | specially, using NAME as the destination for output; any other | 1580 | specially, using NAME as the destination for output; any other |
| 1578 | program is treated like `lpr' except that an explicit filename | 1581 | program is treated like `lpr' except that an explicit filename |
| 1579 | is given as the last argument. | 1582 | is given as the last argument. |
| 1580 | If COMMAND is nil, it's used the default printing program: | 1583 | If COMMAND is nil, it stands for the default printing program: |
| 1581 | `print' for Windows system, `lp' for lp system and `lpr' for | 1584 | `print' for Windows system, `lp' for lp system and `lpr' for |
| 1582 | all other systems. See also `pr-path-alist'. | 1585 | all other systems. See also `pr-path-alist'. |
| 1583 | Examples: | 1586 | Examples: |
| @@ -1756,7 +1759,10 @@ Useful links: | |||
| 1756 | (list | 1759 | (list |
| 1757 | :tag "PostScript Printer" | 1760 | :tag "PostScript Printer" |
| 1758 | (symbol :tag "Printer Symbol Name") | 1761 | (symbol :tag "Printer Symbol Name") |
| 1759 | (string :tag "Printer Command") | 1762 | (choice :menu-tag "Printer Command" |
| 1763 | :tag "Printer Command" | ||
| 1764 | (const :tag "Default print command" nil) | ||
| 1765 | (string :tag "Explicit print command")) | ||
| 1760 | (repeat :tag "Printer Switches" | 1766 | (repeat :tag "Printer Switches" |
| 1761 | (sexp :tag "Switch" :value "")) | 1767 | (sexp :tag "Switch" :value "")) |
| 1762 | (choice :menu-tag "Printer Name Switch" | 1768 | (choice :menu-tag "Printer Name Switch" |
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 87273ec91c0..be67e8db78f 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el | |||
| @@ -1567,6 +1567,7 @@ recommended to enable `electric-pair-mode' with this mode." | |||
| 1567 | (funcall c-ts-mode-indent-style) | 1567 | (funcall c-ts-mode-indent-style) |
| 1568 | (c-ts-mode--simple-indent-rules | 1568 | (c-ts-mode--simple-indent-rules |
| 1569 | 'cpp c-ts-mode-indent-style))) | 1569 | 'cpp c-ts-mode-indent-style))) |
| 1570 | (setq-local editorconfig-indent-size-vars '(c-ts-indent-offset)) | ||
| 1570 | 1571 | ||
| 1571 | ;; Font-lock. | 1572 | ;; Font-lock. |
| 1572 | (setq-local treesit-font-lock-settings | 1573 | (setq-local treesit-font-lock-settings |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 27b2e59409d..07974906a90 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -991,6 +991,8 @@ You might also use mode hooks to specify it in certain modes, like this: | |||
| 991 | (file-name-sans-extension buffer-file-name)))))))) | 991 | (file-name-sans-extension buffer-file-name)))))))) |
| 992 | 992 | ||
| 993 | It's often useful to leave a space at the end of the value." | 993 | It's often useful to leave a space at the end of the value." |
| 994 | :group 'compilation | ||
| 995 | :initialize #'custom-initialize-delay | ||
| 994 | :type 'string) | 996 | :type 'string) |
| 995 | ;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (if (boundp 'compilation-read-command) compilation-read-command t)))) | 997 | ;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (if (boundp 'compilation-read-command) compilation-read-command t)))) |
| 996 | 998 | ||
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index a4f076a6197..0e1ed519b43 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el | |||
| @@ -2,12 +2,12 @@ | |||
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2018-2026 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2018-2026 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Version: 1.21 | 5 | ;; Version: 1.23 |
| 6 | ;; Author: João Távora <joaotavora@gmail.com> | 6 | ;; Author: João Távora <joaotavora@gmail.com> |
| 7 | ;; Maintainer: João Távora <joaotavora@gmail.com> | 7 | ;; Maintainer: João Távora <joaotavora@gmail.com> |
| 8 | ;; URL: https://github.com/joaotavora/eglot | 8 | ;; URL: https://github.com/joaotavora/eglot |
| 9 | ;; Keywords: convenience, languages | 9 | ;; Keywords: convenience, languages |
| 10 | ;; Package-Requires: ((emacs "26.3") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.4.2") (jsonrpc "1.0.26") (project "0.11.2") (seq "2.23") (xref "1.6.2")) | 10 | ;; Package-Requires: ((emacs "26.3") (eldoc "1.16.0") (external-completion "0.1") (flymake "1.4.5") (jsonrpc "1.0.28") (project "0.11.2") (seq "2.23") (xref "1.7.0")) |
| 11 | 11 | ||
| 12 | ;; This is a GNU ELPA :core package. Avoid adding functionality | 12 | ;; This is a GNU ELPA :core package. Avoid adding functionality |
| 13 | ;; that is not available in the version of Emacs recorded above or any | 13 | ;; that is not available in the version of Emacs recorded above or any |
| @@ -2710,10 +2710,11 @@ still unanswered LSP requests to the server\n")))) | |||
| 2710 | 2710 | ||
| 2711 | (defconst eglot-mode-line-progress | 2711 | (defconst eglot-mode-line-progress |
| 2712 | '(:eval | 2712 | '(:eval |
| 2713 | (when-let ((server (eglot-current-server))) | 2713 | (when-let ((s (eglot-current-server))) |
| 2714 | (cl-loop | 2714 | (cl-loop |
| 2715 | for pr hash-values of (eglot--progress-reporters server) | 2715 | for pr in (cl-delete 'eglot--mode-line-reporter |
| 2716 | when (eq (car pr) 'eglot--mode-line-reporter) | 2716 | (hash-table-values (eglot--progress-reporters s)) |
| 2717 | :key #'car :test-not #'eq) | ||
| 2717 | for v = (nth 4 pr) | 2718 | for v = (nth 4 pr) |
| 2718 | when v sum 1 into n and sum v into acc | 2719 | when v sum 1 into n and sum v into acc |
| 2719 | collect (format "(%s) %s %s" (nth 1 pr) (nth 2 pr) (nth 3 pr)) | 2720 | collect (format "(%s) %s %s" (nth 1 pr) (nth 2 pr) (nth 3 pr)) |
| @@ -4092,7 +4093,7 @@ for which LSP on-type-formatting should be requested." | |||
| 4092 | parameter | 4093 | parameter |
| 4093 | ;; ...perhaps highlight it in the formals list | 4094 | ;; ...perhaps highlight it in the formals list |
| 4094 | (when (eq i active-param) | 4095 | (when (eq i active-param) |
| 4095 | (save-excursion ;; FIXME: Sink into the `if' or hoist out of loop? | 4096 | (save-excursion |
| 4096 | (goto-char (point-min)) | 4097 | (goto-char (point-min)) |
| 4097 | (pcase-let | 4098 | (pcase-let |
| 4098 | ((`(,beg ,end) | 4099 | ((`(,beg ,end) |
| @@ -4100,8 +4101,7 @@ for which LSP on-type-formatting should be requested." | |||
| 4100 | (let ((case-fold-search nil)) | 4101 | (let ((case-fold-search nil)) |
| 4101 | (and (search-forward parlabel (line-end-position) t) | 4102 | (and (search-forward parlabel (line-end-position) t) |
| 4102 | (list (match-beginning 0) (match-end 0)))) | 4103 | (list (match-beginning 0) (match-end 0)))) |
| 4103 | (list (+ (point-min) (aref parlabel 0)) | 4104 | (list (1+ (aref parlabel 0)) (1+ (aref parlabel 1)))))) |
| 4104 | (+ (point-min) (aref parlabel 1)))))) | ||
| 4105 | (if (and beg end) | 4105 | (if (and beg end) |
| 4106 | (add-face-text-property | 4106 | (add-face-text-property |
| 4107 | beg end | 4107 | beg end |
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 4e828eba8a0..f62f9f5ce3c 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el | |||
| @@ -1330,6 +1330,8 @@ Interactively, with a prefix arg, FORCE is t." | |||
| 1330 | (buffer (current-buffer))) | 1330 | (buffer (current-buffer))) |
| 1331 | (cl-labels | 1331 | (cl-labels |
| 1332 | ((visible-buffer-window () | 1332 | ((visible-buffer-window () |
| 1333 | ;; This can use `frame-initial-p' once | ||
| 1334 | ;; we can assume Emacs 31 or later. | ||
| 1333 | (and (or (not (daemonp)) | 1335 | (and (or (not (daemonp)) |
| 1334 | (not (eq (selected-frame) terminal-frame))) | 1336 | (not (eq (selected-frame) terminal-frame))) |
| 1335 | (get-buffer-window (current-buffer)))) | 1337 | (get-buffer-window (current-buffer)))) |
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 128952a2dd4..72a05a082bb 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el | |||
| @@ -1089,11 +1089,15 @@ list is empty)." | |||
| 1089 | match) | 1089 | match) |
| 1090 | (while (setq match (text-property-search-forward 'compilation-annotation)) | 1090 | (while (setq match (text-property-search-forward 'compilation-annotation)) |
| 1091 | (add-text-properties (prop-match-beginning match) (prop-match-end match) | 1091 | (add-text-properties (prop-match-beginning match) (prop-match-end match) |
| 1092 | '(read-only t))) | 1092 | '(read-only t front-sticky t))) |
| 1093 | (goto-char (point-min)) | 1093 | (goto-char (point-min)) |
| 1094 | (while (setq match (text-property-search-forward 'compilation-message)) | 1094 | (while (setq match (text-property-search-forward 'compilation-message)) |
| 1095 | (add-text-properties (prop-match-beginning match) (prop-match-end match) | 1095 | (add-text-properties (prop-match-beginning match) (prop-match-end match) |
| 1096 | '(read-only t occur-prefix t)) | 1096 | '( read-only t occur-prefix t |
| 1097 | ;; Allow insertion of text right | ||
| 1098 | ;; after prefix, but not before. | ||
| 1099 | front-sticky t | ||
| 1100 | rear-nonsticky t)) | ||
| 1097 | (let ((loc (compilation--message->loc (prop-match-value match))) | 1101 | (let ((loc (compilation--message->loc (prop-match-value match))) |
| 1098 | m) | 1102 | m) |
| 1099 | ;; Update the markers if necessary. | 1103 | ;; Update the markers if necessary. |
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index ebf8df9f795..2c21d08d448 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el | |||
| @@ -73,6 +73,7 @@ | |||
| 73 | (require 'cl-lib) | 73 | (require 'cl-lib) |
| 74 | (require 'ring) | 74 | (require 'ring) |
| 75 | (require 'project) | 75 | (require 'project) |
| 76 | (require 'text-property-search) | ||
| 76 | 77 | ||
| 77 | (eval-and-compile | 78 | (eval-and-compile |
| 78 | (when (version< emacs-version "28.0.60") | 79 | (when (version< emacs-version "28.0.60") |
| @@ -628,7 +629,7 @@ If SELECT is non-nil, select the target window." | |||
| 628 | (run-hooks 'xref-after-jump-hook))) | 629 | (run-hooks 'xref-after-jump-hook))) |
| 629 | 630 | ||
| 630 | 631 | ||
| 631 | ;;; XREF buffer (part of the UI) | 632 | ;;; Xref buffer (part of the UI) |
| 632 | 633 | ||
| 633 | ;; The xref buffer is used to display a set of xrefs. | 634 | ;; The xref buffer is used to display a set of xrefs. |
| 634 | (defconst xref-buffer-name "*xref*" | 635 | (defconst xref-buffer-name "*xref*" |
| @@ -1004,12 +1005,13 @@ point." | |||
| 1004 | (define-key map (kbd ".") #'xref-next-line) | 1005 | (define-key map (kbd ".") #'xref-next-line) |
| 1005 | (define-key map (kbd ",") #'xref-prev-line) | 1006 | (define-key map (kbd ",") #'xref-prev-line) |
| 1006 | (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) | 1007 | (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) |
| 1008 | (define-key map (kbd "e") #'xref-change-to-xref-edit-mode) | ||
| 1007 | map)) | 1009 | map)) |
| 1008 | 1010 | ||
| 1009 | (declare-function outline-search-text-property "outline" | 1011 | (declare-function outline-search-text-property "outline" |
| 1010 | (property &optional value bound move backward looking-at)) | 1012 | (property &optional value bound move backward looking-at)) |
| 1011 | 1013 | ||
| 1012 | (define-derived-mode xref--xref-buffer-mode special-mode "XREF" | 1014 | (define-derived-mode xref--xref-buffer-mode special-mode "Xref" |
| 1013 | "Mode for displaying cross-references." | 1015 | "Mode for displaying cross-references." |
| 1014 | (setq buffer-read-only t) | 1016 | (setq buffer-read-only t) |
| 1015 | (setq next-error-function #'xref--next-error-function) | 1017 | (setq next-error-function #'xref--next-error-function) |
| @@ -1039,7 +1041,7 @@ point." | |||
| 1039 | 1041 | ||
| 1040 | (define-derived-mode xref--transient-buffer-mode | 1042 | (define-derived-mode xref--transient-buffer-mode |
| 1041 | xref--xref-buffer-mode | 1043 | xref--xref-buffer-mode |
| 1042 | "XREF Transient.") | 1044 | "Xref Transient") |
| 1043 | 1045 | ||
| 1044 | (defun xref--imenu-prev-index-position () | 1046 | (defun xref--imenu-prev-index-position () |
| 1045 | "Move point to previous line in `xref' buffer. | 1047 | "Move point to previous line in `xref' buffer. |
| @@ -1471,6 +1473,106 @@ between them by typing in the minibuffer with completion." | |||
| 1471 | 'xref--show-defs-minibuffer #'xref-show-definitions-completing-read "28.1") | 1473 | 'xref--show-defs-minibuffer #'xref-show-definitions-completing-read "28.1") |
| 1472 | 1474 | ||
| 1473 | 1475 | ||
| 1476 | (defun xref-edit--prepare-buffer () | ||
| 1477 | "Mark relevant regions read-only, and add relevant occur text-properties." | ||
| 1478 | (save-excursion | ||
| 1479 | (goto-char (point-min)) | ||
| 1480 | (let ((inhibit-read-only t) | ||
| 1481 | match) | ||
| 1482 | (while (setq match (text-property-search-forward 'xref-group)) | ||
| 1483 | (add-text-properties (prop-match-beginning match) (prop-match-end match) | ||
| 1484 | '( read-only t | ||
| 1485 | front-sticky t))) | ||
| 1486 | (goto-char (point-min)) | ||
| 1487 | (while (setq match (text-property-search-forward 'xref-item)) | ||
| 1488 | (let ((line-number-end (save-excursion | ||
| 1489 | (forward-line 0) | ||
| 1490 | (and (looking-at " *[0-9]+:") | ||
| 1491 | (match-end 0))))) | ||
| 1492 | (when line-number-end | ||
| 1493 | (add-text-properties (prop-match-beginning match) line-number-end | ||
| 1494 | '( read-only t | ||
| 1495 | occur-prefix t | ||
| 1496 | ;; Allow insertion of text right | ||
| 1497 | ;; after prefix, but not before. | ||
| 1498 | front-sticky t | ||
| 1499 | rear-nonsticky t)))))))) | ||
| 1500 | |||
| 1501 | (defvar xref-edit-mode-map | ||
| 1502 | (let ((map (make-sparse-keymap))) | ||
| 1503 | (define-key map (kbd "C-c C-c") #'xref-edit-save-changes) | ||
| 1504 | (define-key map (kbd "RET") #'xref-goto-xref) | ||
| 1505 | (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack) | ||
| 1506 | (define-key map (kbd "C-o") #'xref-show-location-at-point) | ||
| 1507 | map) | ||
| 1508 | "Keymap for `xref-edit-mode'.") | ||
| 1509 | |||
| 1510 | (defvar xref-edit-mode-hook nil | ||
| 1511 | "Hooks run when changing to Xref-Edit mode.") | ||
| 1512 | |||
| 1513 | (defun xref-edit-mode () | ||
| 1514 | "Major mode for editing *xref* buffers. | ||
| 1515 | In this mode, changes to the *xref* buffer are applied to the | ||
| 1516 | originating files. | ||
| 1517 | \\<xref-edit-mode-map> | ||
| 1518 | Type \\[xref-edit-save-changes] to exit Xref-Edit mode, return to Xref | ||
| 1519 | mode. | ||
| 1520 | |||
| 1521 | The only editable texts in an Xref-Edit buffer are the match results." | ||
| 1522 | (interactive) | ||
| 1523 | (error "This mode can be enabled only by `xref-change-to-xref-edit-mode'")) | ||
| 1524 | (put 'xref-edit-mode 'mode-class 'special) | ||
| 1525 | |||
| 1526 | (defun xref-change-to-xref-edit-mode () | ||
| 1527 | "Switch to `xref-edit-mode' to edit *xref* buffer." | ||
| 1528 | (interactive) | ||
| 1529 | (unless (derived-mode-p 'xref--xref-buffer-mode) | ||
| 1530 | (error "Not an Xref buffer")) | ||
| 1531 | (use-local-map xref-edit-mode-map) | ||
| 1532 | (xref-edit--prepare-buffer) | ||
| 1533 | (setq buffer-read-only nil) | ||
| 1534 | (setq major-mode 'xref-edit-mode) | ||
| 1535 | (setq mode-name "Xref-Edit") | ||
| 1536 | (buffer-enable-undo) | ||
| 1537 | (set-buffer-modified-p nil) | ||
| 1538 | (setq buffer-undo-list nil) | ||
| 1539 | (add-hook 'before-change-functions #'xref-edit--before-change-function nil t) | ||
| 1540 | (add-hook 'after-change-functions #'occur-after-change-function nil t) | ||
| 1541 | (run-mode-hooks 'xref-edit-mode-hook) | ||
| 1542 | (message (substitute-command-keys | ||
| 1543 | "Editing: Type \\[xref-edit-save-changes] to return to Xref mode"))) | ||
| 1544 | |||
| 1545 | (defun xref-edit-save-changes () | ||
| 1546 | "Switch back to Xref mode." | ||
| 1547 | (interactive) | ||
| 1548 | (unless (derived-mode-p 'xref-edit-mode) | ||
| 1549 | (error "Not a Xref-Edit buffer")) | ||
| 1550 | (remove-hook 'before-change-functions #'xref-edit--before-change-function t) | ||
| 1551 | (remove-hook 'after-change-functions #'occur-after-change-function t) | ||
| 1552 | (use-local-map xref--xref-buffer-mode-map) | ||
| 1553 | (setq buffer-read-only t) | ||
| 1554 | (setq major-mode 'xref--xref-buffer-mode) | ||
| 1555 | (setq mode-name "Xref") | ||
| 1556 | (force-mode-line-update) | ||
| 1557 | (buffer-disable-undo) | ||
| 1558 | (setq buffer-undo-list t) | ||
| 1559 | (let ((inhibit-read-only t)) | ||
| 1560 | (remove-text-properties (point-min) (point-max) | ||
| 1561 | '(occur-target nil occur-prefix nil))) | ||
| 1562 | (message "Switching to Xref mode")) | ||
| 1563 | |||
| 1564 | (defun xref-edit--before-change-function (_beg _end) | ||
| 1565 | (when (and (not (get-text-property (pos-bol) 'occur-target)) | ||
| 1566 | (get-text-property (pos-bol) 'occur-prefix)) | ||
| 1567 | (let ((m (xref-location-marker (xref-item-location | ||
| 1568 | (get-text-property (pos-bol) 'xref-item)))) | ||
| 1569 | (inhibit-read-only t) | ||
| 1570 | (inhibit-modification-hooks t) | ||
| 1571 | (buffer-undo-list t)) | ||
| 1572 | (add-text-properties (pos-bol) (pos-eol) | ||
| 1573 | `(occur-target ((,m . ,m))))))) | ||
| 1574 | |||
| 1575 | |||
| 1474 | (defcustom xref-show-xrefs-function 'xref--show-xref-buffer | 1576 | (defcustom xref-show-xrefs-function 'xref--show-xref-buffer |
| 1475 | "Function to display a list of search results. | 1577 | "Function to display a list of search results. |
| 1476 | 1578 | ||
diff --git a/lisp/server.el b/lisp/server.el index fcfc6c01972..f5dea9c590f 100644 --- a/lisp/server.el +++ b/lisp/server.el | |||
| @@ -706,6 +706,7 @@ the `server-process' variable." | |||
| 706 | ;; when we can't get user input, which may happen when | 706 | ;; when we can't get user input, which may happen when |
| 707 | ;; doing emacsclient --eval "(kill-emacs)" in daemon mode. | 707 | ;; doing emacsclient --eval "(kill-emacs)" in daemon mode. |
| 708 | (cond | 708 | (cond |
| 709 | ;; Use `frame-initial-p'? | ||
| 709 | ((and (daemonp) | 710 | ((and (daemonp) |
| 710 | (null (cdr (frame-list))) | 711 | (null (cdr (frame-list))) |
| 711 | (eq (selected-frame) terminal-frame)) | 712 | (eq (selected-frame) terminal-frame)) |
| @@ -1429,6 +1430,7 @@ The following commands are accepted by the client: | |||
| 1429 | (or (eq use-current-frame 'always) | 1430 | (or (eq use-current-frame 'always) |
| 1430 | ;; We can't use the Emacs daemon's | 1431 | ;; We can't use the Emacs daemon's |
| 1431 | ;; terminal frame. | 1432 | ;; terminal frame. |
| 1433 | ;; Use `frame-initial-p'? | ||
| 1432 | (not (and (daemonp) | 1434 | (not (and (daemonp) |
| 1433 | (null (cdr (frame-list))) | 1435 | (null (cdr (frame-list))) |
| 1434 | (eq (selected-frame) | 1436 | (eq (selected-frame) |
| @@ -1453,6 +1455,7 @@ The following commands are accepted by the client: | |||
| 1453 | ;; If there won't be a current frame to use, fall | 1455 | ;; If there won't be a current frame to use, fall |
| 1454 | ;; back to trying to create a new one. | 1456 | ;; back to trying to create a new one. |
| 1455 | ((and use-current-frame | 1457 | ((and use-current-frame |
| 1458 | ;; Use `frame-initial-p'? | ||
| 1456 | (daemonp) | 1459 | (daemonp) |
| 1457 | (null (cdr (frame-list))) | 1460 | (null (cdr (frame-list))) |
| 1458 | (eq (selected-frame) terminal-frame) | 1461 | (eq (selected-frame) terminal-frame) |
diff --git a/lisp/subr.el b/lisp/subr.el index a1d718ca5b7..b0e04bc5f99 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -160,6 +160,10 @@ of previous VARs. | |||
| 160 | (push `(set-default ',(pop args) ,(pop args)) exps)) | 160 | (push `(set-default ',(pop args) ,(pop args)) exps)) |
| 161 | `(progn . ,(nreverse exps)))) | 161 | `(progn . ,(nreverse exps)))) |
| 162 | 162 | ||
| 163 | (defun set-local (variable value) | ||
| 164 | "Make VARIABLE buffer local and set it to VALUE." | ||
| 165 | (set (make-local-variable variable) value)) | ||
| 166 | |||
| 163 | (defmacro setq-local (&rest pairs) | 167 | (defmacro setq-local (&rest pairs) |
| 164 | "Make each VARIABLE local to current buffer and set it to corresponding VALUE. | 168 | "Make each VARIABLE local to current buffer and set it to corresponding VALUE. |
| 165 | 169 | ||
| @@ -181,7 +185,7 @@ In some corner cases you may need to resort to | |||
| 181 | \(fn [VARIABLE VALUE]...)" | 185 | \(fn [VARIABLE VALUE]...)" |
| 182 | (declare (debug setq)) | 186 | (declare (debug setq)) |
| 183 | (unless (evenp (length pairs)) | 187 | (unless (evenp (length pairs)) |
| 184 | (error "PAIRS must have an even number of variable/value members")) | 188 | (signal 'wrong-number-of-arguments (list 'setq-local (length pairs)))) |
| 185 | (let ((expr nil)) | 189 | (let ((expr nil)) |
| 186 | (while pairs | 190 | (while pairs |
| 187 | (unless (symbolp (car pairs)) | 191 | (unless (symbolp (car pairs)) |
| @@ -229,7 +233,7 @@ in order to restore the state of the local variables set via this macro. | |||
| 229 | \(fn [VARIABLE VALUE]...)" | 233 | \(fn [VARIABLE VALUE]...)" |
| 230 | (declare (debug setq)) | 234 | (declare (debug setq)) |
| 231 | (unless (evenp (length pairs)) | 235 | (unless (evenp (length pairs)) |
| 232 | (error "PAIRS must have an even number of variable/value members")) | 236 | (signal 'wrong-number-of-arguments (list 'buffer-local-set-state (length pairs)))) |
| 233 | (let ((vars nil) | 237 | (let ((vars nil) |
| 234 | (tmp pairs)) | 238 | (tmp pairs)) |
| 235 | (while tmp (push (car tmp) vars) (setq tmp (cddr tmp))) | 239 | (while tmp (push (car tmp) vars) (setq tmp (cddr tmp))) |
| @@ -1226,8 +1230,13 @@ with | |||
| 1226 | (member-if (lambda (x) (foo (bar x))) items)" | 1230 | (member-if (lambda (x) (foo (bar x))) items)" |
| 1227 | (declare (compiler-macro | 1231 | (declare (compiler-macro |
| 1228 | (lambda (_) | 1232 | (lambda (_) |
| 1229 | (let ((x (make-symbol "x"))) | 1233 | (let* ((x (make-symbol "x")) |
| 1230 | `(drop-while (lambda (,x) (not (funcall ,pred ,x))) ,list))))) | 1234 | (f (and (not (internal--effect-free-fun-arg-p pred)) |
| 1235 | (make-symbol "f"))) | ||
| 1236 | (form `(drop-while (lambda (,x) | ||
| 1237 | (not (funcall ,(or f pred) ,x))) | ||
| 1238 | ,list))) | ||
| 1239 | (if f `(let ((,f ,pred)) ,form) form))))) | ||
| 1231 | (drop-while (lambda (x) (not (funcall pred x))) list)) | 1240 | (drop-while (lambda (x) (not (funcall pred x))) list)) |
| 1232 | 1241 | ||
| 1233 | ;; This is good to have for improved readability in certain uses, but | 1242 | ;; This is good to have for improved readability in certain uses, but |
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index ad749557987..3399e5ef93e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el | |||
| @@ -292,6 +292,7 @@ a list of frames to update." | |||
| 292 | (and (eq auto-resize-tab-bars 'grow-only) | 292 | (and (eq auto-resize-tab-bars 'grow-only) |
| 293 | (> (frame-parameter frame 'tab-bar-lines) 1)) | 293 | (> (frame-parameter frame 'tab-bar-lines) 1)) |
| 294 | ;; Don't enable tab-bar in daemon's initial frame. | 294 | ;; Don't enable tab-bar in daemon's initial frame. |
| 295 | ;; Use `frame-initial-p'? | ||
| 295 | (and (daemonp) (eq frame terminal-frame))) | 296 | (and (daemonp) (eq frame terminal-frame))) |
| 296 | (set-frame-parameter frame 'tab-bar-lines | 297 | (set-frame-parameter frame 'tab-bar-lines |
| 297 | (tab-bar--tab-bar-lines-for-frame frame))))) | 298 | (tab-bar--tab-bar-lines-for-frame frame))))) |
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index a56fc018e18..355555df090 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el | |||
| @@ -3,7 +3,7 @@ | |||
| 3 | ;; Copyright (C) 2006-2026 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2006-2026 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> |
| 6 | ;; Maintainer: Simen Heggestøyl <simenheg@gmail.com> | 6 | ;; Maintainer: Simen Heggestøyl <simenheg@runbox.com> |
| 7 | ;; Keywords: hypermedia | 7 | ;; Keywords: hypermedia |
| 8 | 8 | ||
| 9 | ;; This file is part of GNU Emacs. | 9 | ;; This file is part of GNU Emacs. |
| @@ -66,7 +66,7 @@ | |||
| 66 | 66 | ||
| 67 | (defconst css-pseudo-class-ids | 67 | (defconst css-pseudo-class-ids |
| 68 | '("active" "checked" "default" "disabled" "empty" "enabled" "first" | 68 | '("active" "checked" "default" "disabled" "empty" "enabled" "first" |
| 69 | "first-child" "first-of-type" "focus" "focus-within" "hover" | 69 | "first-child" "first-of-type" "focus" "focus-within" "has" "hover" |
| 70 | "in-range" "indeterminate" "invalid" "lang" "last-child" | 70 | "in-range" "indeterminate" "invalid" "lang" "last-child" |
| 71 | "last-of-type" "left" "link" "not" "nth-child" "nth-last-child" | 71 | "last-of-type" "left" "link" "not" "nth-child" "nth-last-child" |
| 72 | "nth-last-of-type" "nth-of-type" "only-child" "only-of-type" | 72 | "nth-last-of-type" "nth-of-type" "only-child" "only-of-type" |
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index a269cae0c9b..c5ae2a15557 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el | |||
| @@ -390,6 +390,16 @@ which can be the value of the `face' text property." | |||
| 390 | (list (list "x-color" (cadr face)))) | 390 | (list (list "x-color" (cadr face)))) |
| 391 | ((and (listp face) (eq (car face) :background)) | 391 | ((and (listp face) (eq (car face) :background)) |
| 392 | (list (list "x-bg-color" (cadr face)))) | 392 | (list (list "x-bg-color" (cadr face)))) |
| 393 | ((and (listp face) (eq (car face) :underline)) | ||
| 394 | (list (list "underline"))) | ||
| 395 | ((and (listp face) | ||
| 396 | (eq (car face) :weight) | ||
| 397 | (eq (cadr face) 'bold)) | ||
| 398 | (list (list "bold"))) | ||
| 399 | ((and (listp face) | ||
| 400 | (eq (car face) :slant) | ||
| 401 | (memq (cadr face) '(italic oblique))) | ||
| 402 | (list (list "italic"))) | ||
| 393 | ((listp face) | 403 | ((listp face) |
| 394 | (apply #'append (mapcar #'enriched-face-ans face))) | 404 | (apply #'append (mapcar #'enriched-face-ans face))) |
| 395 | ((let* ((fg (face-attribute face :foreground)) | 405 | ((let* ((fg (face-attribute face :foreground)) |
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 9445b4a6b9a..c1ccdf2ec5f 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el | |||
| @@ -1700,7 +1700,7 @@ and URL `https://rhodesmill.org/brandon/2012/one-sentence-per-line/'." | |||
| 1700 | (to (copy-marker (max from to) t)) | 1700 | (to (copy-marker (max from to) t)) |
| 1701 | pfx) | 1701 | pfx) |
| 1702 | (goto-char from) | 1702 | (goto-char from) |
| 1703 | (let ((fill-column (* 2 (point-max)))) ; Wide characters span up to two columns. | 1703 | (let ((fill-column most-positive-fixnum)) |
| 1704 | (setq pfx (or (save-excursion | 1704 | (setq pfx (or (save-excursion |
| 1705 | (fill-region-as-paragraph-default (point) | 1705 | (fill-region-as-paragraph-default (point) |
| 1706 | to | 1706 | to |
diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el index cc3eaf03e15..657d6bc466d 100644 --- a/lisp/textmodes/markdown-ts-mode.el +++ b/lisp/textmodes/markdown-ts-mode.el | |||
| @@ -40,6 +40,7 @@ | |||
| 40 | (require 'treesit) | 40 | (require 'treesit) |
| 41 | (require 'subr-x) | 41 | (require 'subr-x) |
| 42 | (require 'outline) | 42 | (require 'outline) |
| 43 | (require 'seq) | ||
| 43 | 44 | ||
| 44 | (treesit-declare-unavailable-functions) | 45 | (treesit-declare-unavailable-functions) |
| 45 | 46 | ||
| @@ -296,7 +297,12 @@ the same features enabled in MODE." | |||
| 296 | (plist-get configs :simple-indent))) | 297 | (plist-get configs :simple-indent))) |
| 297 | (setq treesit-range-settings | 298 | (setq treesit-range-settings |
| 298 | (append treesit-range-settings | 299 | (append treesit-range-settings |
| 299 | (plist-get configs :range))) | 300 | ;; Filter out function queries, because they are |
| 301 | ;; usually some hack and might escape the code block. | ||
| 302 | ;; Case in point: c-ts-mode's range setting. | ||
| 303 | (seq-filter (lambda (setting) | ||
| 304 | (not (functionp (car setting)))) | ||
| 305 | (plist-get configs :range)))) | ||
| 300 | (setq-local indent-line-function #'treesit-indent) | 306 | (setq-local indent-line-function #'treesit-indent) |
| 301 | (setq-local indent-region-function #'treesit-indent-region))) | 307 | (setq-local indent-region-function #'treesit-indent-region))) |
| 302 | 308 | ||
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index b7f72f2619c..671cf5a1547 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el | |||
| @@ -53,7 +53,7 @@ with %, which are converted as follows: | |||
| 53 | %H 24-hour clock hour %I 12-hour clock hour | 53 | %H 24-hour clock hour %I 12-hour clock hour |
| 54 | %m month number | 54 | %m month number |
| 55 | %M minute | 55 | %M minute |
| 56 | %p meridian indicator: `AM', `PM' | 56 | %p meridiem indicator: `AM', `PM' |
| 57 | %S seconds | 57 | %S seconds |
| 58 | %w day number of week, Sunday is 0 | 58 | %w day number of week, Sunday is 0 |
| 59 | %Y 4-digit year %y 2-digit year | 59 | %Y 4-digit year %y 2-digit year |
| @@ -1039,39 +1039,45 @@ This is an internal function called by `time-stamp'." | |||
| 1039 | offset-secs) | 1039 | offset-secs) |
| 1040 | "Format a time offset according to a %z variation. | 1040 | "Format a time offset according to a %z variation. |
| 1041 | 1041 | ||
| 1042 | With no flags, the output includes hours and minutes: +-HHMM | 1042 | Format parts FLAG-MINIMIZE, FLAG-PAD-SPACES-ONLY, |
| 1043 | unless there is a non-zero seconds part, in which case the seconds | 1043 | FLAG-PAD-ZEROS-FIRST, COLON-COUNT, and FIELD-WIDTH |
| 1044 | are included: +-HHMMSS | 1044 | are used to format time zone offset OFFSET-SECS. |
| 1045 | |||
| 1046 | FLAG-MINIMIZE is whether \"-\" was specified. If non-nil, the | ||
| 1047 | output may be limited to hours if minutes and seconds are zero. | ||
| 1048 | |||
| 1049 | FLAG-PAD-SPACES-ONLY is whether \"_\" was specified. If non-nil, | ||
| 1050 | seconds must be output, so that any padding can be spaces only. | ||
| 1051 | |||
| 1052 | FLAG-PAD-ZEROS-FIRST is whether \"0\" was specified. If non-nil, | ||
| 1053 | padding to the requested FIELD-WIDTH (if any) is done by adding | ||
| 1054 | 00 seconds before padding with spaces. | ||
| 1055 | |||
| 1056 | COLON-COUNT is the number of colons preceding the \"z\" (0-3). One or | ||
| 1057 | two colons put that many colons in the output (+-HH:MM or +-HH:MM:SS). | ||
| 1058 | Three colons outputs only hours if minutes and seconds are zero and | ||
| 1059 | includes colon separators if minutes and seconds are output. | ||
| 1060 | |||
| 1061 | FIELD-WIDTH is a whole number giving the minimum number of characters | ||
| 1062 | in the output; 0 specifies no minimum. Additional characters will be | ||
| 1063 | added on the right if necessary. The added characters will be spaces | ||
| 1064 | unless FLAG-PAD-ZEROS-FIRST is non-nil. | ||
| 1065 | |||
| 1066 | OFFSET-SECS is the time zone offset (in seconds east of UTC) to be | ||
| 1067 | formatted according to the preceding parameters. | ||
| 1068 | 1045 | ||
| 1069 | This is an internal function used by `time-stamp'." | 1046 | This is an internal function used by `time-stamp'." |
| 1047 | |||
| 1070 | ;; Callers of this function need to have already parsed the %z | 1048 | ;; Callers of this function need to have already parsed the %z |
| 1071 | ;; format string; this function accepts just the parts of the format. | 1049 | ;; format string; this function accepts just the parts of the format. |
| 1072 | ;; `time-stamp-string-preprocess' is the full-fledged parser normally | 1050 | ;; `time-stamp-string-preprocess' is the full-fledged parser normally |
| 1073 | ;; used. The unit test (in time-stamp-tests.el) defines the simpler | 1051 | ;; used. The unit test (in time-stamp-tests.el) defines the simpler |
| 1074 | ;; parser `format-time-offset'. | 1052 | ;; parser `format-time-offset'. |
| 1053 | |||
| 1054 | ;; OFFSET-SECS is the time zone offset (in seconds east of UTC) to be | ||
| 1055 | ;; formatted according to the following parameters. | ||
| 1056 | |||
| 1057 | ;; FLAG-MINIMIZE is whether \"-\" was specified. If non-nil, the | ||
| 1058 | ;; output may be limited to hours if minutes and seconds are zero. | ||
| 1059 | |||
| 1060 | ;; FLAG-PAD-SPACES-ONLY is whether \"_\" was specified. If non-nil, | ||
| 1061 | ;; seconds must be output, so that any padding can be spaces only. | ||
| 1062 | |||
| 1063 | ;; FLAG-PAD-ZEROS-FIRST is whether \"0\" was specified. If non-nil, | ||
| 1064 | ;; padding to the requested FIELD-WIDTH (if any) is done by adding | ||
| 1065 | ;; 00 seconds before padding with spaces. | ||
| 1066 | |||
| 1067 | ;; COLON-COUNT is the number of colons preceding the \"z\" (0-3). One or | ||
| 1068 | ;; two colons put that many colons in the output (+-HH:MM or +-HH:MM:SS). | ||
| 1069 | ;; Three colons outputs only hours if minutes and seconds are zero and | ||
| 1070 | ;; includes colon separators if minutes and seconds are output. | ||
| 1071 | |||
| 1072 | ;; FIELD-WIDTH is a whole number giving the minimum number of characters | ||
| 1073 | ;; in the output; 0 specifies no minimum. Additional characters will be | ||
| 1074 | ;; added on the right if necessary. The added characters will be spaces | ||
| 1075 | ;; unless FLAG-PAD-ZEROS-FIRST is non-nil. | ||
| 1076 | |||
| 1077 | ;; With no flags set, the output includes hours and minutes: +-HHMM | ||
| 1078 | ;; unless there is a non-zero seconds part, in which case the seconds | ||
| 1079 | ;; are included: +-HHMMSS | ||
| 1080 | |||
| 1075 | (let ((hrs (/ (abs offset-secs) 3600)) | 1081 | (let ((hrs (/ (abs offset-secs) 3600)) |
| 1076 | (mins (/ (% (abs offset-secs) 3600) 60)) | 1082 | (mins (/ (% (abs offset-secs) 3600) 60)) |
| 1077 | (secs (% (abs offset-secs) 60)) | 1083 | (secs (% (abs offset-secs) 60)) |
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 73df2e0bca8..d9b1f50b40c 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el | |||
| @@ -330,7 +330,7 @@ holds a keymap." | |||
| 330 | :vert-only t) | 330 | :vert-only t) |
| 331 | (tool-bar-add-item-from-menu 'menu-find-file-existing "open" nil | 331 | (tool-bar-add-item-from-menu 'menu-find-file-existing "open" nil |
| 332 | :label "Open" :vert-only t) | 332 | :label "Open" :vert-only t) |
| 333 | (tool-bar-add-item-from-menu 'dired "diropen" nil :vert-only t) | 333 | (tool-bar-add-item-from-menu 'dired-from-menubar "diropen" nil :vert-only t) |
| 334 | (tool-bar-add-item-from-menu 'kill-this-buffer "close" nil :vert-only t) | 334 | (tool-bar-add-item-from-menu 'kill-this-buffer "close" nil :vert-only t) |
| 335 | (tool-bar-add-item-from-menu 'save-buffer "save" nil | 335 | (tool-bar-add-item-from-menu 'save-buffer "save" nil |
| 336 | :label "Save") | 336 | :label "Save") |
diff --git a/lisp/treesit.el b/lisp/treesit.el index 7d6113e3249..14c05b0dd16 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el | |||
| @@ -753,10 +753,10 @@ that encompasses the region between START and END." | |||
| 753 | (numberp (cdr range-offset))) | 753 | (numberp (cdr range-offset))) |
| 754 | (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset))) | 754 | (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset))) |
| 755 | (setq offset range-offset))) | 755 | (setq offset range-offset))) |
| 756 | (:range-fn (let ((range-fn (pop query-specs))) | 756 | (:range-fn (let ((fn (pop query-specs))) |
| 757 | (unless (functionp range-fn) | 757 | (unless (functionp fn) |
| 758 | (signal 'treesit-error (list "Value of :range-fn option should be a function" range-fn))) | 758 | (signal 'treesit-error (list "Value of :range-fn option should be a function" fn))) |
| 759 | (setq range-fn range-fn))) | 759 | (setq range-fn fn))) |
| 760 | (query (if (functionp query) | 760 | (query (if (functionp query) |
| 761 | (push (list query nil nil) result) | 761 | (push (list query nil nil) result) |
| 762 | (when (null embed) | 762 | (when (null embed) |
| @@ -1423,22 +1423,31 @@ LANGUAGE is the language of QUERY.") | |||
| 1423 | (setf (nth 1 new-setting) t) | 1423 | (setf (nth 1 new-setting) t) |
| 1424 | new-setting)) | 1424 | new-setting)) |
| 1425 | 1425 | ||
| 1426 | (defun treesit--font-lock-level-setter (sym val) | 1426 | (defun treesit--font-lock-level-setter (sym val &optional buffer-local) |
| 1427 | "Custom setter for `treesit-font-lock-level'. | 1427 | "Custom setter for `treesit-font-lock-level'. |
| 1428 | Set the default value of SYM to VAL, recompute fontification | 1428 | Set the default value of SYM to VAL, recompute fontification |
| 1429 | features and refontify for every buffer where tree-sitter-based | 1429 | features and refontify for every buffer where tree-sitter-based |
| 1430 | fontification is enabled." | 1430 | fontification is enabled. |
| 1431 | (set-default sym val) | 1431 | |
| 1432 | (when (treesit-available-p) | 1432 | If optional BUFFER-LOCAL is non-nil, only affect the current buffer. |
| 1433 | (dolist (buffer (buffer-list)) | 1433 | Set SYM buffer locally and refontify." |
| 1434 | (with-current-buffer buffer | 1434 | ;; FIXME: This doesn't re-run major mode hooks, meaning any |
| 1435 | ;; FIXME: This doesn't re-run major mode hooks, meaning any | 1435 | ;; customization done in major mode hooks (e.g., with |
| 1436 | ;; customization done in major mode hooks (e.g., with | 1436 | ;; `treesit-font-lock-recompute-features') may be overridden. |
| 1437 | ;; `treesit-font-lock-recompute-features') is lost. | 1437 | (cond (buffer-local |
| 1438 | (when treesit-font-lock-settings | 1438 | (set-local sym val) |
| 1439 | (treesit-font-lock-recompute-features) | 1439 | (when (and (treesit-available-p) |
| 1440 | (treesit-font-lock-fontify-region | 1440 | treesit-font-lock-settings) |
| 1441 | (point-min) (point-max))))))) | 1441 | (treesit-font-lock-recompute-features) |
| 1442 | (font-lock-flush))) | ||
| 1443 | (t | ||
| 1444 | (set-default sym val) | ||
| 1445 | (when (treesit-available-p) | ||
| 1446 | (dolist (buffer (buffer-list)) | ||
| 1447 | (with-current-buffer buffer | ||
| 1448 | (when treesit-font-lock-settings | ||
| 1449 | (treesit-font-lock-recompute-features) | ||
| 1450 | (font-lock-flush)))))))) | ||
| 1442 | 1451 | ||
| 1443 | (defcustom treesit-font-lock-level 3 | 1452 | (defcustom treesit-font-lock-level 3 |
| 1444 | "Decoration level to be used by tree-sitter fontifications. | 1453 | "Decoration level to be used by tree-sitter fontifications. |
| @@ -2050,9 +2059,8 @@ If LOUDLY is non-nil, display some debugging information." | |||
| 2050 | (pcase-let ((`(,max-depth ,max-width) | 2059 | (pcase-let ((`(,max-depth ,max-width) |
| 2051 | (treesit-subtree-stat | 2060 | (treesit-subtree-stat |
| 2052 | (treesit-buffer-root-node language)))) | 2061 | (treesit-buffer-root-node language)))) |
| 2053 | (if (or (> max-depth 100) (> max-width 4000)) | 2062 | (setq treesit--font-lock-fast-mode |
| 2054 | (setq treesit--font-lock-fast-mode t) | 2063 | (or (> max-depth 100) (> max-width 4000))))) |
| 2055 | (setq treesit--font-lock-fast-mode nil)))) | ||
| 2056 | 2064 | ||
| 2057 | ;; Only activate if ENABLE flag is t. | 2065 | ;; Only activate if ENABLE flag is t. |
| 2058 | (when-let* | 2066 | (when-let* |
| @@ -5849,7 +5857,7 @@ language." | |||
| 5849 | "Pattern matching" | 5857 | "Pattern matching" |
| 5850 | (treesit-query-capture | 5858 | (treesit-query-capture |
| 5851 | :no-eval (treesit-query-capture node '((identifier) @id "return" @ret)) | 5859 | :no-eval (treesit-query-capture node '((identifier) @id "return" @ret)) |
| 5852 | :eg-result-string "((id . #<treesit-node (identifier) in 195-196>) (ret . #<treesit-node "return" in 338-344>))") | 5860 | :eg-result-string "((id . #<treesit-node (identifier) in 195-196>) (ret . #<treesit-node \"return\" in 338-344>))") |
| 5853 | (treesit-query-compile | 5861 | (treesit-query-compile |
| 5854 | :no-eval (treesit-query-compile 'c '((identifier) @id "return" @ret)) | 5862 | :no-eval (treesit-query-compile 'c '((identifier) @id "return" @ret)) |
| 5855 | :eg-result-string "#<treesit-compiled-query>") | 5863 | :eg-result-string "#<treesit-compiled-query>") |
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 042733f4c61..2dcae7362b7 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el | |||
| @@ -977,6 +977,7 @@ In the latter case, VC mode is deactivated for this buffer." | |||
| 977 | noninteractive | 977 | noninteractive |
| 978 | ;; Copied from server-start. Seems like there should | 978 | ;; Copied from server-start. Seems like there should |
| 979 | ;; be a better way to ask "can we get user input?"... | 979 | ;; be a better way to ask "can we get user input?"... |
| 980 | ;; Use `frame-initial-p'? | ||
| 980 | (and (daemonp) | 981 | (and (daemonp) |
| 981 | (null (cdr (frame-list))) | 982 | (null (cdr (frame-list))) |
| 982 | (eq (selected-frame) terminal-frame)) | 983 | (eq (selected-frame) terminal-frame)) |
diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 9eb88eb35d0..50a687fe16b 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el | |||
| @@ -907,9 +907,9 @@ means that `whitespace-mode' is turned on for buffers in C and | |||
| 907 | C++ modes only. | 907 | C++ modes only. |
| 908 | 908 | ||
| 909 | Global `whitespace-mode' will not automatically turn on in internal | 909 | Global `whitespace-mode' will not automatically turn on in internal |
| 910 | buffers (with name starting from space) and special buffers (with name | 910 | buffers (whose names start with a space) and special buffers (whose |
| 911 | starting from \"*\"), except \"*scratch*\" buffer. Use | 911 | names start with \"*\"), with the exception of the \"*scratch*\" buffer. |
| 912 | `whitespace-global-mode-buffers' to customize this behavior." | 912 | Use `whitespace-global-mode-buffers' to customize this behavior." |
| 913 | :type '(choice :tag "Global Modes" | 913 | :type '(choice :tag "Global Modes" |
| 914 | (const :tag "None" nil) | 914 | (const :tag "None" nil) |
| 915 | (const :tag "All" t) | 915 | (const :tag "All" t) |
| @@ -919,11 +919,11 @@ starting from \"*\"), except \"*scratch*\" buffer. Use | |||
| 919 | (repeat :inline t | 919 | (repeat :inline t |
| 920 | (symbol :tag "Mode"))))) | 920 | (symbol :tag "Mode"))))) |
| 921 | 921 | ||
| 922 | (defcustom whitespace-global-mode-buffers (list (regexp-quote "*scratch*")) | 922 | (defcustom whitespace-global-mode-buffers (list (rx bos "*scratch*" eos)) |
| 923 | "Buffer name regexps where global `whitespace-mode' can be auto-enabled. | 923 | "Buffer name regexps where global `whitespace-mode' can be auto-enabled. |
| 924 | The value is a list of regexps. Set this custom option when you need | 924 | The value is a list of regexps. Set this custom option when you need |
| 925 | `whitespace-mode' in special buffers like *Org Src*." | 925 | `whitespace-mode' in special buffers like \"*Org Src*\"." |
| 926 | :type '(list (regexp :tag "Regexp matching buffer name")) | 926 | :type '(repeat (regexp :tag "Regexp matching buffer name")) |
| 927 | :version "31.1") | 927 | :version "31.1") |
| 928 | 928 | ||
| 929 | (defcustom whitespace-action nil | 929 | (defcustom whitespace-action nil |
| @@ -1049,14 +1049,13 @@ See also `whitespace-newline' and `whitespace-display-mappings'." | |||
| 1049 | ;; ...we have a display (not running a batch job) | 1049 | ;; ...we have a display (not running a batch job) |
| 1050 | (not noninteractive) | 1050 | (not noninteractive) |
| 1051 | ;; ...the buffer is not internal (name starts with a space) | 1051 | ;; ...the buffer is not internal (name starts with a space) |
| 1052 | (not (eq (aref (buffer-name) 0) ?\ )) | 1052 | (not (eq (aref (buffer-name) 0) ?\s)) |
| 1053 | ;; ...the buffer is not special (name starts with *) | 1053 | ;; ...the buffer is not special (name starts with *) |
| 1054 | (or (not (eq (aref (buffer-name) 0) ?*)) | 1054 | (or (not (eq (aref (buffer-name) 0) ?*)) |
| 1055 | ;; except the scratch buffer. | 1055 | ;; except, e.g., the scratch buffer. |
| 1056 | (seq-find | 1056 | (any (lambda (re) |
| 1057 | (lambda (re) | 1057 | (string-match-p re (buffer-name))) |
| 1058 | (string-match-p re (buffer-name))) | 1058 | whitespace-global-mode-buffers)))) |
| 1059 | whitespace-global-mode-buffers)))) | ||
| 1060 | "Predicate to decide which buffers obey `global-whitespace-mode'. | 1059 | "Predicate to decide which buffers obey `global-whitespace-mode'. |
| 1061 | This function is called with no argument and should return non-nil | 1060 | This function is called with no argument and should return non-nil |
| 1062 | if the current buffer should obey `global-whitespace-mode'. | 1061 | if the current buffer should obey `global-whitespace-mode'. |
diff --git a/lisp/window.el b/lisp/window.el index 1f7ae726f49..bd0653fe0d4 100644 --- a/lisp/window.el +++ b/lisp/window.el | |||
| @@ -1010,6 +1010,14 @@ and may be called only if no window on SIDE exists yet." | |||
| 1010 | (cons `(dedicated . ,(or display-buffer-mark-dedicated 'side)) | 1010 | (cons `(dedicated . ,(or display-buffer-mark-dedicated 'side)) |
| 1011 | alist)))) | 1011 | alist)))) |
| 1012 | (when window | 1012 | (when window |
| 1013 | ;; Protect the sibling (the main-window group) from recombination. | ||
| 1014 | ;; Without this, deleting a side window can flatten the group into | ||
| 1015 | ;; the root, causing subsequent side windows on other sides to be | ||
| 1016 | ;; placed incorrectly (Bug#80665). | ||
| 1017 | (when-let* ((sibling (or (window-prev-sibling window) | ||
| 1018 | (window-next-sibling window))) | ||
| 1019 | ((window-child sibling))) | ||
| 1020 | (set-window-combination-limit sibling t)) | ||
| 1013 | ;; Initialize `window-side' parameter of new window to SIDE and | 1021 | ;; Initialize `window-side' parameter of new window to SIDE and |
| 1014 | ;; make that parameter persistent. | 1022 | ;; make that parameter persistent. |
| 1015 | (set-window-parameter window 'window-side side) | 1023 | (set-window-parameter window 'window-side side) |
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 67c475d563a..b93d914380f 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el | |||
| @@ -509,16 +509,14 @@ enable, ?l to disable)." | |||
| 509 | "Enable xterm mouse tracking on TERMINAL." | 509 | "Enable xterm mouse tracking on TERMINAL." |
| 510 | (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)) | 510 | (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)) |
| 511 | ;; Avoid the initial terminal which is not a termcap device. | 511 | ;; Avoid the initial terminal which is not a termcap device. |
| 512 | ;; FIXME: is there more elegant way to detect the initial | 512 | (not (frame-initial-p terminal))) |
| 513 | ;; terminal? | ||
| 514 | (not (string= (terminal-name terminal) "initial_terminal"))) | ||
| 515 | (unless (terminal-parameter terminal 'xterm-mouse-mode) | 513 | (unless (terminal-parameter terminal 'xterm-mouse-mode) |
| 516 | ;; Simulate selecting a terminal by selecting one of its frames | 514 | ;; Simulate selecting a terminal by selecting one of its frames |
| 517 | ;; so that we can set the terminal-local `input-decode-map'. | 515 | ;; so that we can set the terminal-local `input-decode-map'. |
| 518 | ;; Use the tty-top-frame to avoid accidentally making an invisible | 516 | ;; Use the tty-top-frame to avoid accidentally making an invisible |
| 519 | ;; child frame visible by selecting it (bug#79960). | 517 | ;; child frame visible by selecting it (bug#79960). |
| 520 | ;; The test for match mode is here because xt-mouse-tests run in | 518 | ;; The test for batch mode is here because xt-mouse-tests run in |
| 521 | ;; match mode, and there is no top-frame in that case. | 519 | ;; batch mode, and there is no top-frame in that case. |
| 522 | (with-selected-frame (if noninteractive | 520 | (with-selected-frame (if noninteractive |
| 523 | (car (frame-list)) | 521 | (car (frame-list)) |
| 524 | (tty-top-frame terminal)) | 522 | (tty-top-frame terminal)) |
diff --git a/src/bidi.c b/src/bidi.c index f4bca186177..9cf53787c4b 100644 --- a/src/bidi.c +++ b/src/bidi.c | |||
| @@ -367,6 +367,8 @@ bidi_isolate_fmt_char (bidi_type_t ch_type) | |||
| 367 | return (ch_type == LRI || ch_type == RLI || ch_type == PDI || ch_type == FSI); | 367 | return (ch_type == LRI || ch_type == RLI || ch_type == PDI || ch_type == FSI); |
| 368 | } | 368 | } |
| 369 | 369 | ||
| 370 | static void bidi_initialize (void); | ||
| 371 | |||
| 370 | /* Return the mirrored character of C, if it has one. If C has no | 372 | /* Return the mirrored character of C, if it has one. If C has no |
| 371 | mirrored counterpart, return C. | 373 | mirrored counterpart, return C. |
| 372 | Note: The conditions in UAX#9 clause L4 regarding the surrounding | 374 | Note: The conditions in UAX#9 clause L4 regarding the surrounding |
| @@ -381,6 +383,14 @@ bidi_mirror_char (int c) | |||
| 381 | if (c < 0 || c > MAX_CHAR) | 383 | if (c < 0 || c > MAX_CHAR) |
| 382 | emacs_abort (); | 384 | emacs_abort (); |
| 383 | 385 | ||
| 386 | /* We can be called at the very beginning of init_iterator, via | ||
| 387 | produce_special_glyphs, and the first such call in a session might | ||
| 388 | happen when the bidi-mirroring table was not yet initialized. Make | ||
| 389 | sure we do this now. */ | ||
| 390 | if (!CHAR_TABLE_P (bidi_mirror_table) | ||
| 391 | && !bidi_initialized) | ||
| 392 | bidi_initialize (); | ||
| 393 | |||
| 384 | val = CHAR_TABLE_REF (bidi_mirror_table, c); | 394 | val = CHAR_TABLE_REF (bidi_mirror_table, c); |
| 385 | if (FIXNUMP (val)) | 395 | if (FIXNUMP (val)) |
| 386 | { | 396 | { |
diff --git a/src/charset.c b/src/charset.c index 041f350cf8e..524966d5fbc 100644 --- a/src/charset.c +++ b/src/charset.c | |||
| @@ -799,7 +799,7 @@ Optional 4th and 5th arguments FROM-CODE and TO-CODE specify the | |||
| 799 | range of code points (in CHARSET) of target characters on which to | 799 | range of code points (in CHARSET) of target characters on which to |
| 800 | map the FUNCTION. Note that these are not character codes, but code | 800 | map the FUNCTION. Note that these are not character codes, but code |
| 801 | points of CHARSET; for the difference see `decode-char' and | 801 | points of CHARSET; for the difference see `decode-char' and |
| 802 | `list-charset-chars'. If FROM-CODE is nil or imitted, it stands for | 802 | `list-charset-chars'. If FROM-CODE is nil or omitted, it stands for |
| 803 | the first code point of CHARSET; if TO-CODE is nil or omitted, it | 803 | the first code point of CHARSET; if TO-CODE is nil or omitted, it |
| 804 | stands for the last code point of CHARSET. | 804 | stands for the last code point of CHARSET. |
| 805 | 805 | ||
| @@ -840,7 +840,7 @@ TO-CODE, which are CHARSET code points. */) | |||
| 840 | /* Define a charset according to the arguments. The Nth argument is | 840 | /* Define a charset according to the arguments. The Nth argument is |
| 841 | the Nth attribute of the charset (the last attribute `charset-id' | 841 | the Nth attribute of the charset (the last attribute `charset-id' |
| 842 | is not included). See the docstring of `define-charset' for the | 842 | is not included). See the docstring of `define-charset' for the |
| 843 | detail. */ | 843 | details. */ |
| 844 | 844 | ||
| 845 | DEFUN ("define-charset-internal", Fdefine_charset_internal, | 845 | DEFUN ("define-charset-internal", Fdefine_charset_internal, |
| 846 | Sdefine_charset_internal, charset_arg_max, MANY, 0, | 846 | Sdefine_charset_internal, charset_arg_max, MANY, 0, |
| @@ -1530,7 +1530,7 @@ BEG and END are buffer positions. | |||
| 1530 | Optional arg TABLE if non-nil is a translation table to look up. | 1530 | Optional arg TABLE if non-nil is a translation table to look up. |
| 1531 | 1531 | ||
| 1532 | If the current buffer is unibyte, the returned list may contain | 1532 | If the current buffer is unibyte, the returned list may contain |
| 1533 | only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) | 1533 | only `ascii' and `eight-bit'. */) |
| 1534 | (Lisp_Object beg, Lisp_Object end, Lisp_Object table) | 1534 | (Lisp_Object beg, Lisp_Object end, Lisp_Object table) |
| 1535 | { | 1535 | { |
| 1536 | Lisp_Object charsets; | 1536 | Lisp_Object charsets; |
| @@ -1581,7 +1581,7 @@ DEFUN ("find-charset-string", Ffind_charset_string, Sfind_charset_string, | |||
| 1581 | Optional arg TABLE if non-nil is a translation table to look up. | 1581 | Optional arg TABLE if non-nil is a translation table to look up. |
| 1582 | 1582 | ||
| 1583 | If STR is unibyte, the returned list may contain | 1583 | If STR is unibyte, the returned list may contain |
| 1584 | only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) | 1584 | only `ascii' and `eight-bit'. */) |
| 1585 | (Lisp_Object str, Lisp_Object table) | 1585 | (Lisp_Object str, Lisp_Object table) |
| 1586 | { | 1586 | { |
| 1587 | CHECK_STRING (str); | 1587 | CHECK_STRING (str); |
| @@ -2036,7 +2036,7 @@ ASCII characters are an exception: for them, this function always | |||
| 2036 | returns `ascii'. | 2036 | returns `ascii'. |
| 2037 | If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets | 2037 | If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets |
| 2038 | from which to find the charset. It may also be a coding system. In | 2038 | from which to find the charset. It may also be a coding system. In |
| 2039 | that case, find the charset from what supported by that coding system. */) | 2039 | that case, find the charset in those supported by that coding system. */) |
| 2040 | (Lisp_Object ch, Lisp_Object restriction) | 2040 | (Lisp_Object ch, Lisp_Object restriction) |
| 2041 | { | 2041 | { |
| 2042 | struct charset *charset; | 2042 | struct charset *charset; |
diff --git a/src/chartab.c b/src/chartab.c index 3076f72c06e..7d2710f20a3 100644 --- a/src/chartab.c +++ b/src/chartab.c | |||
| @@ -78,7 +78,7 @@ sub_char_table_ref_and_range (Lisp_Object, int, int *, int *, | |||
| 78 | /* Nonzero iff OBJ is a string representing uniprop values of 128 | 78 | /* Nonzero iff OBJ is a string representing uniprop values of 128 |
| 79 | succeeding characters (the bottom level of a char-table) by a | 79 | succeeding characters (the bottom level of a char-table) by a |
| 80 | compressed format. We are sure that no property value has a string | 80 | compressed format. We are sure that no property value has a string |
| 81 | starting with '\001' nor '\002'. */ | 81 | starting with '\001' or '\002'. */ |
| 82 | #define UNIPROP_COMPRESSED_FORM_P(OBJ) \ | 82 | #define UNIPROP_COMPRESSED_FORM_P(OBJ) \ |
| 83 | (STRINGP (OBJ) && SCHARS (OBJ) > 0 \ | 83 | (STRINGP (OBJ) && SCHARS (OBJ) > 0 \ |
| 84 | && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2)))) | 84 | && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2)))) |
diff --git a/src/dispnew.c b/src/dispnew.c index 15d3c2a599a..45211b9d2e9 100644 --- a/src/dispnew.c +++ b/src/dispnew.c | |||
| @@ -6826,8 +6826,7 @@ FILE = nil means just close any termscript file currently open. */) | |||
| 6826 | { | 6826 | { |
| 6827 | struct tty_display_info *tty; | 6827 | struct tty_display_info *tty; |
| 6828 | 6828 | ||
| 6829 | if (! FRAME_TERMCAP_P (SELECTED_FRAME ()) | 6829 | if (!is_tty_frame (SELECTED_FRAME ())) |
| 6830 | && ! FRAME_MSDOS_P (SELECTED_FRAME ())) | ||
| 6831 | error ("Current frame is not on a tty device"); | 6830 | error ("Current frame is not on a tty device"); |
| 6832 | 6831 | ||
| 6833 | tty = CURTTY (); | 6832 | tty = CURTTY (); |
| @@ -7394,7 +7393,7 @@ init_display_interactive (void) | |||
| 7394 | t = init_tty (0, terminal_type, 1); /* Errors are fatal. */ | 7393 | t = init_tty (0, terminal_type, 1); /* Errors are fatal. */ |
| 7395 | 7394 | ||
| 7396 | /* Convert the initial frame to use the new display. */ | 7395 | /* Convert the initial frame to use the new display. */ |
| 7397 | if (f->output_method != output_initial) | 7396 | if (!FRAME_INITIAL_P (f)) |
| 7398 | emacs_abort (); | 7397 | emacs_abort (); |
| 7399 | f->output_method = t->type; | 7398 | f->output_method = t->type; |
| 7400 | f->terminal = t; | 7399 | f->terminal = t; |
| @@ -7404,7 +7403,7 @@ init_display_interactive (void) | |||
| 7404 | f->output_data.tty = &the_only_tty_output; | 7403 | f->output_data.tty = &the_only_tty_output; |
| 7405 | f->output_data.tty->display_info = &the_only_display_info; | 7404 | f->output_data.tty->display_info = &the_only_display_info; |
| 7406 | #else | 7405 | #else |
| 7407 | if (f->output_method == output_termcap) | 7406 | if (FRAME_TERMCAP_P (f)) |
| 7408 | create_tty_output (f); | 7407 | create_tty_output (f); |
| 7409 | #endif | 7408 | #endif |
| 7410 | t->display_info.tty->top_frame = selected_frame; | 7409 | t->display_info.tty->top_frame = selected_frame; |
diff --git a/src/dosfns.c b/src/dosfns.c index 414cc550510..07d553b0d78 100644 --- a/src/dosfns.c +++ b/src/dosfns.c | |||
| @@ -681,8 +681,7 @@ dos_cleanup (void) | |||
| 681 | { | 681 | { |
| 682 | struct frame *sf = XFRAME (selected_frame); | 682 | struct frame *sf = XFRAME (selected_frame); |
| 683 | 683 | ||
| 684 | if (FRAME_LIVE_P (sf) | 684 | if (FRAME_LIVE_P (sf) && is_tty_frame (sf)) |
| 685 | && (FRAME_MSDOS_P (sf) || FRAME_TERMCAP_P (sf))) | ||
| 686 | { | 685 | { |
| 687 | tty = CURTTY (); | 686 | tty = CURTTY (); |
| 688 | if (tty->termscript) | 687 | if (tty->termscript) |
diff --git a/src/fileio.c b/src/fileio.c index 2d62bb21c17..cf77bfec695 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -774,6 +774,9 @@ Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs | |||
| 774 | working directory. If TEXT is a string, insert it into the newly | 774 | working directory. If TEXT is a string, insert it into the newly |
| 775 | created file. | 775 | created file. |
| 776 | 776 | ||
| 777 | On Posix systems, the file/directory is created with access mode bits | ||
| 778 | that limit access to the current user. | ||
| 779 | |||
| 777 | Signal an error if the file could not be created. | 780 | Signal an error if the file could not be created. |
| 778 | 781 | ||
| 779 | This function does not grok magic file names. */) | 782 | This function does not grok magic file names. */) |
diff --git a/src/frame.c b/src/frame.c index 20481c230d1..2475eb84df3 100644 --- a/src/frame.c +++ b/src/frame.c | |||
| @@ -214,7 +214,7 @@ frame_inhibit_resize (struct frame *f, bool horizontal, Lisp_Object parameter) | |||
| 214 | && !NILP (fullscreen) && !EQ (fullscreen, Qfullheight)) | 214 | && !NILP (fullscreen) && !EQ (fullscreen, Qfullheight)) |
| 215 | || (!horizontal | 215 | || (!horizontal |
| 216 | && !NILP (fullscreen) && !EQ (fullscreen, Qfullwidth)) | 216 | && !NILP (fullscreen) && !EQ (fullscreen, Qfullwidth)) |
| 217 | || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)))); | 217 | || is_tty_frame (f)))); |
| 218 | } | 218 | } |
| 219 | 219 | ||
| 220 | 220 | ||
| @@ -349,8 +349,6 @@ If FRAME is nil, use the selected frame. | |||
| 349 | Return nil if the id has not been set. */) | 349 | Return nil if the id has not been set. */) |
| 350 | (Lisp_Object frame) | 350 | (Lisp_Object frame) |
| 351 | { | 351 | { |
| 352 | if (NILP (frame)) | ||
| 353 | frame = selected_frame; | ||
| 354 | struct frame *f = decode_live_frame (frame); | 352 | struct frame *f = decode_live_frame (frame); |
| 355 | if (f->id == 0) | 353 | if (f->id == 0) |
| 356 | return Qnil; | 354 | return Qnil; |
| @@ -562,7 +560,7 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, | |||
| 562 | 560 | ||
| 563 | /* Don't allow too small height of text-mode frames, or else cm.c | 561 | /* Don't allow too small height of text-mode frames, or else cm.c |
| 564 | might abort in cmcheckmagic. */ | 562 | might abort in cmcheckmagic. */ |
| 565 | if ((FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) && NILP (horizontal)) | 563 | if (is_tty_frame (f) && NILP (horizontal)) |
| 566 | { | 564 | { |
| 567 | int min_height = (FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f) | 565 | int min_height = (FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f) |
| 568 | + FRAME_WANTS_MODELINE_P (f) | 566 | + FRAME_WANTS_MODELINE_P (f) |
| @@ -1573,7 +1571,7 @@ make_terminal_frame (struct terminal *terminal, Lisp_Object parent, | |||
| 1573 | f->output_data.tty->display_info = &the_only_display_info; | 1571 | f->output_data.tty->display_info = &the_only_display_info; |
| 1574 | if (!inhibit_window_system | 1572 | if (!inhibit_window_system |
| 1575 | && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)) | 1573 | && (!FRAMEP (selected_frame) || !FRAME_LIVE_P (XFRAME (selected_frame)) |
| 1576 | || XFRAME (selected_frame)->output_method == output_msdos_raw)) | 1574 | || FRAME_MSDOS_P (XFRAME (selected_frame)))) |
| 1577 | f->output_method = output_msdos_raw; | 1575 | f->output_method = output_msdos_raw; |
| 1578 | else | 1576 | else |
| 1579 | f->output_method = output_termcap; | 1577 | f->output_method = output_termcap; |
| @@ -1763,13 +1761,12 @@ affects all frames on the same terminal device. */) | |||
| 1763 | struct frame *sf = SELECTED_FRAME (); | 1761 | struct frame *sf = SELECTED_FRAME (); |
| 1764 | 1762 | ||
| 1765 | #ifdef MSDOS | 1763 | #ifdef MSDOS |
| 1766 | if (sf->output_method != output_msdos_raw | 1764 | if (!is_tty_frame (sf)) |
| 1767 | && sf->output_method != output_termcap) | ||
| 1768 | emacs_abort (); | 1765 | emacs_abort (); |
| 1769 | #else /* not MSDOS */ | 1766 | #else /* not MSDOS */ |
| 1770 | 1767 | ||
| 1771 | #ifdef WINDOWSNT /* This should work now! */ | 1768 | #ifdef WINDOWSNT /* This should work now! */ |
| 1772 | if (sf->output_method != output_termcap) | 1769 | if (!FRAME_TERMCAP_P (sf)) |
| 1773 | error ("Not using an ASCII terminal now; cannot make a new ASCII frame"); | 1770 | error ("Not using an ASCII terminal now; cannot make a new ASCII frame"); |
| 1774 | #endif | 1771 | #endif |
| 1775 | #endif /* not MSDOS */ | 1772 | #endif /* not MSDOS */ |
| @@ -1986,7 +1983,7 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor | |||
| 1986 | if (!for_deletion && FRAME_HAS_MINIBUF_P (sf)) | 1983 | if (!for_deletion && FRAME_HAS_MINIBUF_P (sf)) |
| 1987 | resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1); | 1984 | resize_mini_window (XWINDOW (FRAME_MINIBUF_WINDOW (sf)), 1); |
| 1988 | 1985 | ||
| 1989 | if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) | 1986 | if (is_tty_frame (f)) |
| 1990 | { | 1987 | { |
| 1991 | struct tty_display_info *tty = FRAME_TTY (f); | 1988 | struct tty_display_info *tty = FRAME_TTY (f); |
| 1992 | Lisp_Object top_frame = tty->top_frame; | 1989 | Lisp_Object top_frame = tty->top_frame; |
| @@ -2800,7 +2797,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) | |||
| 2800 | && FRAME_LIVE_P (f1) | 2797 | && FRAME_LIVE_P (f1) |
| 2801 | && !FRAME_TOOLTIP_P (f1)) | 2798 | && !FRAME_TOOLTIP_P (f1)) |
| 2802 | { | 2799 | { |
| 2803 | if (FRAME_TERMCAP_P (f1) || FRAME_MSDOS_P (f1)) | 2800 | if (is_tty_frame (f1)) |
| 2804 | { | 2801 | { |
| 2805 | Lisp_Object top_frame = FRAME_TTY (f1)->top_frame; | 2802 | Lisp_Object top_frame = FRAME_TTY (f1)->top_frame; |
| 2806 | 2803 | ||
diff --git a/src/keyboard.c b/src/keyboard.c index c63440059e5..3da42d61bad 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -2453,7 +2453,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, | |||
| 2453 | #else | 2453 | #else |
| 2454 | struct frame *frame = XFRAME (selected_frame); | 2454 | struct frame *frame = XFRAME (selected_frame); |
| 2455 | struct terminal *terminal = frame->terminal; | 2455 | struct terminal *terminal = frame->terminal; |
| 2456 | if (!((FRAME_TERMCAP_P (frame) || FRAME_MSDOS_P (frame)) | 2456 | if (!(is_tty_frame (frame) |
| 2457 | /* Don't apply decoding if we're just reading a raw event | 2457 | /* Don't apply decoding if we're just reading a raw event |
| 2458 | (e.g. reading bytes sent by the xterm to specify the position | 2458 | (e.g. reading bytes sent by the xterm to specify the position |
| 2459 | of a mouse click). */ | 2459 | of a mouse click). */ |
| @@ -13032,7 +13032,7 @@ The elements of this list correspond to the arguments of | |||
| 13032 | 13032 | ||
| 13033 | Lisp_Object interrupt = interrupt_input ? Qt : Qnil; | 13033 | Lisp_Object interrupt = interrupt_input ? Qt : Qnil; |
| 13034 | Lisp_Object flow, meta; | 13034 | Lisp_Object flow, meta; |
| 13035 | if (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)) | 13035 | if (is_tty_frame (sf)) |
| 13036 | { | 13036 | { |
| 13037 | flow = FRAME_TTY (sf)->flow_control ? Qt : Qnil; | 13037 | flow = FRAME_TTY (sf)->flow_control ? Qt : Qnil; |
| 13038 | meta = (FRAME_TTY (sf)->meta_key == 2 | 13038 | meta = (FRAME_TTY (sf)->meta_key == 2 |
diff --git a/src/lisp.h b/src/lisp.h index 05ea874a4bb..2081a45458f 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -5754,7 +5754,7 @@ extern void *w32_daemon_event; | |||
| 5754 | /* True if handling a fatal error already. */ | 5754 | /* True if handling a fatal error already. */ |
| 5755 | extern bool fatal_error_in_progress; | 5755 | extern bool fatal_error_in_progress; |
| 5756 | 5756 | ||
| 5757 | /* True means don't do use window-system-specific display code. */ | 5757 | /* True means don't use window-system-specific display code. */ |
| 5758 | extern bool inhibit_window_system; | 5758 | extern bool inhibit_window_system; |
| 5759 | /* True means that a filter or a sentinel is running. */ | 5759 | /* True means that a filter or a sentinel is running. */ |
| 5760 | extern bool running_asynch_code; | 5760 | extern bool running_asynch_code; |
diff --git a/src/menu.c b/src/menu.c index 747a87e9f3c..cb474a1b53e 100644 --- a/src/menu.c +++ b/src/menu.c | |||
| @@ -405,8 +405,7 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk | |||
| 405 | } | 405 | } |
| 406 | } | 406 | } |
| 407 | 407 | ||
| 408 | if ((FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame)) | 408 | if (is_tty_frame (XFRAME (Vmenu_updating_frame)) |
| 409 | || FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame))) | ||
| 410 | && !NILP (map)) | 409 | && !NILP (map)) |
| 411 | /* Indicate visually that this is a submenu. */ | 410 | /* Indicate visually that this is a submenu. */ |
| 412 | { | 411 | { |
diff --git a/src/msdos.c b/src/msdos.c index 7e89d549706..4d111b30969 100644 --- a/src/msdos.c +++ b/src/msdos.c | |||
| @@ -1787,7 +1787,7 @@ internal_terminal_init (void) | |||
| 1787 | #endif | 1787 | #endif |
| 1788 | 1788 | ||
| 1789 | /* If this is the initial terminal, we are done here. */ | 1789 | /* If this is the initial terminal, we are done here. */ |
| 1790 | if (sf->output_method == output_initial) | 1790 | if (FRAME_INITIAL_P (sf)) |
| 1791 | return; | 1791 | return; |
| 1792 | 1792 | ||
| 1793 | internal_terminal | 1793 | internal_terminal |
diff --git a/src/nsterm.m b/src/nsterm.m index 118463a13c9..e186c16e725 100644 --- a/src/nsterm.m +++ b/src/nsterm.m | |||
| @@ -72,6 +72,12 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) | |||
| 72 | #include "macfont.h" | 72 | #include "macfont.h" |
| 73 | #include <Carbon/Carbon.h> | 73 | #include <Carbon/Carbon.h> |
| 74 | #include <IOSurface/IOSurface.h> | 74 | #include <IOSurface/IOSurface.h> |
| 75 | /* ApplicationServices provides the macOS accessibility Zoom API | ||
| 76 | UAZoomEnabled and UAZoomChangeFocus (UniversalAccess framework). | ||
| 77 | Carbon.h already pulls in ApplicationServices on most SDK versions, | ||
| 78 | but the explicit import makes the dependency visible and guards | ||
| 79 | against SDK changes. */ | ||
| 80 | #import <ApplicationServices/ApplicationServices.h> | ||
| 75 | #endif | 81 | #endif |
| 76 | 82 | ||
| 77 | static EmacsMenu *dockMenu; | 83 | static EmacsMenu *dockMenu; |
| @@ -1086,6 +1092,126 @@ ns_update_begin (struct frame *f) | |||
| 1086 | [view lockFocus]; | 1092 | [view lockFocus]; |
| 1087 | } | 1093 | } |
| 1088 | 1094 | ||
| 1095 | /* -------------------------------------------------------------------------- | ||
| 1096 | macOS Accessibility Zoom Support | ||
| 1097 | -------------------------------------------------------------------------- */ | ||
| 1098 | #ifdef NS_IMPL_COCOA | ||
| 1099 | |||
| 1100 | static BOOL ns_is_UAZoomEnabled = NO; | ||
| 1101 | static unsigned long ns_UAZoomEnabled_last_called_time_ns = 0; | ||
| 1102 | static const unsigned long NS_UAZOOMENABLED_CACHE_INTERVAL_NS = | ||
| 1103 | (unsigned long)(500 * NSEC_PER_MSEC); /* 500ms. */ | ||
| 1104 | static NSTimeInterval NS_UAZOOMENABLED_DEFER_INTERVAL_SECS = 0.2; /* 200ms. */ | ||
| 1105 | static NSTimer *ns_deferred_UAZoomChangeFocus_timer = nil; | ||
| 1106 | |||
| 1107 | static BOOL | ||
| 1108 | ns_ua_zoom_enabled_p (void) | ||
| 1109 | /* -------------------------------------------------------------------------- | ||
| 1110 | Return the cached result of UAZoomEnabled. Refresh the cache every | ||
| 1111 | NS_UAZOOMENABLED_CACHE_INTERVAL_NS nanoseconds. | ||
| 1112 | |||
| 1113 | We cache the result to avoid the macOS Mach IPC Accessibility Server | ||
| 1114 | round trip cost on every Emacs cursor update. Since enabling Zoom | ||
| 1115 | requires an explicit user UI action that takes real user time, the | ||
| 1116 | cache TTL should be invisible to the user. | ||
| 1117 | |||
| 1118 | Use clock_gettime_nsec_np not CFAbsoluteTimeGetCurrent which depends | ||
| 1119 | on the wall clock which can be reset by the user or by NTP. | ||
| 1120 | |||
| 1121 | Main-thread-only and called from ns_update_end, below. | ||
| 1122 | -------------------------------------------------------------------------- */ | ||
| 1123 | { | ||
| 1124 | /* User-space equivalent to mach_absolute_time. */ | ||
| 1125 | unsigned long now_ns = clock_gettime_nsec_np (CLOCK_UPTIME_RAW); | ||
| 1126 | if (now_ns - ns_UAZoomEnabled_last_called_time_ns | ||
| 1127 | > NS_UAZOOMENABLED_CACHE_INTERVAL_NS) | ||
| 1128 | { | ||
| 1129 | ns_is_UAZoomEnabled = UAZoomEnabled (); | ||
| 1130 | ns_UAZoomEnabled_last_called_time_ns = now_ns; | ||
| 1131 | } | ||
| 1132 | return ns_is_UAZoomEnabled; | ||
| 1133 | } | ||
| 1134 | |||
| 1135 | static inline CGRect | ||
| 1136 | ns_cg_rect_flip_y (CGRect r) | ||
| 1137 | /* -------------------------------------------------------------------------- | ||
| 1138 | Convert a CGRect from Cocoa screen coordinates (origin at bottom-left | ||
| 1139 | of the primary display) to CoreGraphics coordinates (origin at | ||
| 1140 | top-left of the primary display). CoreGraphics defines its | ||
| 1141 | coordinate origin at the top-left corner of the primary display and | ||
| 1142 | all screens share this global coordinate space, so the flip always | ||
| 1143 | uses the primary display height regardless of which screen R is on. | ||
| 1144 | -------------------------------------------------------------------------- */ | ||
| 1145 | { | ||
| 1146 | CGDirectDisplayID mainID = CGMainDisplayID (); | ||
| 1147 | if (mainID == kCGNullDirectDisplay) | ||
| 1148 | return r; | ||
| 1149 | CGFloat primaryH = CGDisplayBounds (mainID).size.height; | ||
| 1150 | if (primaryH <= 0) | ||
| 1151 | return r; | ||
| 1152 | r.origin.y = primaryH - r.origin.y - r.size.height; | ||
| 1153 | return r; | ||
| 1154 | } | ||
| 1155 | |||
| 1156 | /* Cache cursor rects to call UAZoomChangeFocus only when the cursor | ||
| 1157 | position has changed, not merely when the cursor is blinking. | ||
| 1158 | See ns_draw_window_cursor and ns_update_end. */ | ||
| 1159 | static NSRect ns_UAZoom_cursor_rect_new; | ||
| 1160 | static NSRect ns_UAZoom_cursor_rect_old; | ||
| 1161 | |||
| 1162 | /* Track Zoom state per display cycle. Update the macOS Zoom cursor | ||
| 1163 | position when Zoom transitions to enabled. */ | ||
| 1164 | static BOOL ns_update_was_UAZoomEnabled = NO; | ||
| 1165 | |||
| 1166 | static void | ||
| 1167 | ns_UAZoomChangeFocus (EmacsView *view, BOOL force) | ||
| 1168 | /* -------------------------------------------------------------------------- | ||
| 1169 | Advise macOS Accessibility Zoom UAZoomChangeFocus of a potentially | ||
| 1170 | new cursor position. Force an updated position when Zoom transitions | ||
| 1171 | to enabled, or when the frame gets focus. | ||
| 1172 | -------------------------------------------------------------------------- */ | ||
| 1173 | { | ||
| 1174 | if (ns_ua_zoom_enabled_p ()) | ||
| 1175 | { | ||
| 1176 | force = force || !ns_update_was_UAZoomEnabled; | ||
| 1177 | ns_update_was_UAZoomEnabled = YES; | ||
| 1178 | if (NSIsEmptyRect (ns_UAZoom_cursor_rect_new)) | ||
| 1179 | return; | ||
| 1180 | if (force || !NSEqualRects (ns_UAZoom_cursor_rect_new, | ||
| 1181 | ns_UAZoom_cursor_rect_old)) | ||
| 1182 | { | ||
| 1183 | ns_UAZoom_cursor_rect_old = ns_UAZoom_cursor_rect_new; | ||
| 1184 | NSRect windowRect = [view convertRect:ns_UAZoom_cursor_rect_new | ||
| 1185 | toView:nil]; | ||
| 1186 | NSRect screenRect = [[view window] convertRectToScreen:windowRect]; | ||
| 1187 | CGRect cgRect = ns_cg_rect_flip_y (NSRectToCGRect (screenRect)); | ||
| 1188 | /* Some versions of macOS can ignore tiny rects, so we | ||
| 1189 | slightly expand a tiny one. Since we care mostly about its | ||
| 1190 | origin, this should be innocuous. */ | ||
| 1191 | cgRect.size.width = MAX (cgRect.size.width, 6); | ||
| 1192 | cgRect.size.height = MAX (cgRect.size.height, 10); | ||
| 1193 | if (force) | ||
| 1194 | { | ||
| 1195 | /* UAZoomChangeFocus needs old and new cursor positions to | ||
| 1196 | be different, and also it sometimes needs a kick. In | ||
| 1197 | both cases, we fake a cursor move followed by the real | ||
| 1198 | cursor move. */ | ||
| 1199 | CGRect cgRectJiggle = CGRectOffset (cgRect, 1.0, 1.0); | ||
| 1200 | if (UAZoomChangeFocus (&cgRectJiggle, NULL, | ||
| 1201 | kUAZoomFocusTypeInsertionPoint)) | ||
| 1202 | NSLog (@"UAZoomChangeFocus jiggle failed"); | ||
| 1203 | } | ||
| 1204 | if (UAZoomChangeFocus (&cgRect, NULL, | ||
| 1205 | kUAZoomFocusTypeInsertionPoint)) | ||
| 1206 | NSLog (@"UAZoomChangeFocus failed"); | ||
| 1207 | NSAccessibilityPostNotification | ||
| 1208 | (view, NSAccessibilityFocusedUIElementChangedNotification); | ||
| 1209 | } | ||
| 1210 | } | ||
| 1211 | else | ||
| 1212 | ns_update_was_UAZoomEnabled = NO; | ||
| 1213 | } | ||
| 1214 | #endif /* NS_IMPL_COCOA */ | ||
| 1089 | 1215 | ||
| 1090 | static void | 1216 | static void |
| 1091 | ns_update_end (struct frame *f) | 1217 | ns_update_end (struct frame *f) |
| @@ -1108,6 +1234,10 @@ ns_update_end (struct frame *f) | |||
| 1108 | [[view window] flushWindow]; | 1234 | [[view window] flushWindow]; |
| 1109 | #endif | 1235 | #endif |
| 1110 | 1236 | ||
| 1237 | #ifdef NS_IMPL_COCOA | ||
| 1238 | ns_UAZoomChangeFocus (view, false); | ||
| 1239 | #endif | ||
| 1240 | |||
| 1111 | unblock_input (); | 1241 | unblock_input (); |
| 1112 | ns_updating_frame = NULL; | 1242 | ns_updating_frame = NULL; |
| 1113 | } | 1243 | } |
| @@ -3238,6 +3368,16 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, | |||
| 3238 | /* Prevent the cursor from being drawn outside the text area. */ | 3368 | /* Prevent the cursor from being drawn outside the text area. */ |
| 3239 | r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA)); | 3369 | r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA)); |
| 3240 | 3370 | ||
| 3371 | #ifdef NS_IMPL_COCOA | ||
| 3372 | /* Cache the cursor rect for macOS Accessibility Zoom integration (see | ||
| 3373 | ns_update_end). Only store the rect for the active cursor --- | ||
| 3374 | inactive windows must not overwrite the value because redisplay may | ||
| 3375 | draw multiple windows per frame and the drawing order is not | ||
| 3376 | guaranteed. */ | ||
| 3377 | if (active_p) | ||
| 3378 | ns_UAZoom_cursor_rect_new = r; | ||
| 3379 | #endif | ||
| 3380 | |||
| 3241 | ns_focus (f, NULL, 0); | 3381 | ns_focus (f, NULL, 0); |
| 3242 | 3382 | ||
| 3243 | NSGraphicsContext *ctx = [NSGraphicsContext currentContext]; | 3383 | NSGraphicsContext *ctx = [NSGraphicsContext currentContext]; |
| @@ -6384,6 +6524,14 @@ ns_term_shutdown (int sig) | |||
| 6384 | } | 6524 | } |
| 6385 | #endif | 6525 | #endif |
| 6386 | 6526 | ||
| 6527 | #ifdef NS_IMPL_COCOA | ||
| 6528 | /* Is accessibility enabled for this process/bundle? */ | ||
| 6529 | if (AXIsProcessTrusted()) | ||
| 6530 | NSLog (@"Emacs is macOS AXIsProcessTrusted"); | ||
| 6531 | else | ||
| 6532 | NSLog (@"Emacs is not macOS AXIsProcessTrusted"); | ||
| 6533 | #endif | ||
| 6534 | |||
| 6387 | ns_send_appdefined (-2); | 6535 | ns_send_appdefined (-2); |
| 6388 | } | 6536 | } |
| 6389 | 6537 | ||
| @@ -7300,6 +7448,12 @@ ns_create_font_panel_buttons (id target, SEL select, SEL cancel_action) | |||
| 7300 | return [self firstRectForCharacterRange: range]; | 7448 | return [self firstRectForCharacterRange: range]; |
| 7301 | } | 7449 | } |
| 7302 | 7450 | ||
| 7451 | - (NSRect)accessibilityFrame | ||
| 7452 | { | ||
| 7453 | EmacsView *view = FRAME_NS_VIEW (*emacsframe); | ||
| 7454 | return [[view window] convertRectToScreen: ns_UAZoom_cursor_rect_new]; | ||
| 7455 | } | ||
| 7456 | |||
| 7303 | #endif /* NS_IMPL_COCOA */ | 7457 | #endif /* NS_IMPL_COCOA */ |
| 7304 | 7458 | ||
| 7305 | /*********************************************************************** | 7459 | /*********************************************************************** |
| @@ -8257,12 +8411,48 @@ ns_in_echo_area (void) | |||
| 8257 | ns_frame_rehighlight (*emacsframe); | 8411 | ns_frame_rehighlight (*emacsframe); |
| 8258 | [self adjustEmacsFrameRect]; | 8412 | [self adjustEmacsFrameRect]; |
| 8259 | 8413 | ||
| 8414 | #ifdef NS_IMPL_COCOA | ||
| 8415 | EmacsView *view = FRAME_NS_VIEW (*emacsframe); | ||
| 8416 | /* Make sure we have focus and the timer isn't already scheduled. */ | ||
| 8417 | if (self.window.firstResponder == view | ||
| 8418 | && !ns_deferred_UAZoomChangeFocus_timer) | ||
| 8419 | { | ||
| 8420 | /* Calls to ns_UAZoomChangeFocus are synchronous. We defer the | ||
| 8421 | call to give macOS time to finish window compositing or the | ||
| 8422 | calls can be silently ignored by the Zoom daemon and with no | ||
| 8423 | errors reported. This also helps ensure ns_draw_window_cursor | ||
| 8424 | has populated ns_UAZoom_cursor_rect_new. The 200 ms delay was | ||
| 8425 | chosen as a balance between macOS headroom and user | ||
| 8426 | perception. */ | ||
| 8427 | ns_deferred_UAZoomChangeFocus_timer | ||
| 8428 | = [[NSTimer | ||
| 8429 | scheduledTimerWithTimeInterval: | ||
| 8430 | NS_UAZOOMENABLED_DEFER_INTERVAL_SECS | ||
| 8431 | target: self | ||
| 8432 | selector: | ||
| 8433 | @selector (deferred_UAZoomChangeFocus_handler:) | ||
| 8434 | userInfo: 0 | ||
| 8435 | repeats: NO] | ||
| 8436 | retain]; | ||
| 8437 | } | ||
| 8438 | #endif | ||
| 8439 | |||
| 8260 | event.kind = FOCUS_IN_EVENT; | 8440 | event.kind = FOCUS_IN_EVENT; |
| 8261 | XSETFRAME (event.frame_or_window, *emacsframe); | 8441 | XSETFRAME (event.frame_or_window, *emacsframe); |
| 8262 | kbd_buffer_store_event (&event); | 8442 | kbd_buffer_store_event (&event); |
| 8263 | ns_send_appdefined (-1); // Kick main loop | 8443 | ns_send_appdefined (-1); // Kick main loop |
| 8264 | } | 8444 | } |
| 8265 | 8445 | ||
| 8446 | #ifdef NS_IMPL_COCOA | ||
| 8447 | - (void)deferred_UAZoomChangeFocus_handler: (NSTimer *)timer | ||
| 8448 | { | ||
| 8449 | EmacsView *view = FRAME_NS_VIEW (*emacsframe); | ||
| 8450 | ns_UAZoomChangeFocus (view, true); | ||
| 8451 | [ns_deferred_UAZoomChangeFocus_timer invalidate]; | ||
| 8452 | [ns_deferred_UAZoomChangeFocus_timer release]; | ||
| 8453 | ns_deferred_UAZoomChangeFocus_timer = nil; | ||
| 8454 | } | ||
| 8455 | #endif | ||
| 8266 | 8456 | ||
| 8267 | - (void)windowDidResignKey: (NSNotification *)notification | 8457 | - (void)windowDidResignKey: (NSNotification *)notification |
| 8268 | /* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */ | 8458 | /* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */ |
| @@ -8365,6 +8555,13 @@ ns_in_echo_area (void) | |||
| 8365 | 8555 | ||
| 8366 | FRAME_NS_VIEW (f) = self; | 8556 | FRAME_NS_VIEW (f) = self; |
| 8367 | *emacsframe = f; | 8557 | *emacsframe = f; |
| 8558 | |||
| 8559 | #ifdef NS_IMPL_COCOA | ||
| 8560 | /* macOS Accessibility Zoom Support. */ | ||
| 8561 | ns_UAZoom_cursor_rect_new = NSZeroRect; | ||
| 8562 | ns_UAZoom_cursor_rect_old = NSZeroRect; | ||
| 8563 | #endif | ||
| 8564 | |||
| 8368 | #ifdef NS_IMPL_COCOA | 8565 | #ifdef NS_IMPL_COCOA |
| 8369 | old_title = 0; | 8566 | old_title = 0; |
| 8370 | maximizing_resize = NO; | 8567 | maximizing_resize = NO; |
diff --git a/src/pgtkterm.c b/src/pgtkterm.c index e0eb81bf81c..c1e00347343 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c | |||
| @@ -703,33 +703,16 @@ pgtk_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) | |||
| 703 | 703 | ||
| 704 | static void | 704 | static void |
| 705 | pgtk_set_window_size (struct frame *f, bool change_gravity, | 705 | pgtk_set_window_size (struct frame *f, bool change_gravity, |
| 706 | int width, int height) | 706 | int pixelwidth, int pixelheight) |
| 707 | /* -------------------------------------------------------------------------- | 707 | /* -------------------------------------------------------------------------- |
| 708 | Adjust window pixel size based on given character grid size | 708 | Adjust window pixel size based on given width and height. |
| 709 | Impl is a bit more complex than other terms, need to do some | ||
| 710 | internal clipping. | ||
| 711 | -------------------------------------------------------------------------- */ | 709 | -------------------------------------------------------------------------- */ |
| 712 | { | 710 | { |
| 713 | int pixelwidth, pixelheight; | ||
| 714 | |||
| 715 | block_input (); | 711 | block_input (); |
| 716 | 712 | ||
| 717 | gtk_widget_get_size_request (FRAME_GTK_WIDGET (f), &pixelwidth, | ||
| 718 | &pixelheight); | ||
| 719 | |||
| 720 | pixelwidth = width; | ||
| 721 | pixelheight = height; | ||
| 722 | |||
| 723 | for (GtkWidget * w = FRAME_GTK_WIDGET (f); w != NULL; | ||
| 724 | w = gtk_widget_get_parent (w)) | ||
| 725 | { | ||
| 726 | gint wd, hi; | ||
| 727 | gtk_widget_get_size_request (w, &wd, &hi); | ||
| 728 | } | ||
| 729 | |||
| 730 | f->output_data.pgtk->preferred_width = pixelwidth; | 713 | f->output_data.pgtk->preferred_width = pixelwidth; |
| 731 | f->output_data.pgtk->preferred_height = pixelheight; | 714 | f->output_data.pgtk->preferred_height = pixelheight; |
| 732 | xg_wm_set_size_hint (f, 0, 0); | 715 | |
| 733 | xg_frame_set_char_size (f, pixelwidth, pixelheight); | 716 | xg_frame_set_char_size (f, pixelwidth, pixelheight); |
| 734 | gtk_widget_queue_resize (FRAME_WIDGET (f)); | 717 | gtk_widget_queue_resize (FRAME_WIDGET (f)); |
| 735 | 718 | ||
| @@ -5722,10 +5705,11 @@ pgtk_focus_changed (gboolean is_enter, int state, | |||
| 5722 | 5705 | ||
| 5723 | /* Don't stop displaying the initial startup message | 5706 | /* Don't stop displaying the initial startup message |
| 5724 | for a switch-frame event we don't need. */ | 5707 | for a switch-frame event we don't need. */ |
| 5725 | /* When run as a daemon, Vterminal_frame is always NIL. */ | 5708 | /* When run as a daemon, Vterminal_frame is always nil. |
| 5709 | FIXME: Isn't it actually the other way around? */ | ||
| 5726 | bufp->ie.arg = (((NILP (Vterminal_frame) | 5710 | bufp->ie.arg = (((NILP (Vterminal_frame) |
| 5727 | || !FRAME_PGTK_P (XFRAME (Vterminal_frame)) | 5711 | || !FRAME_PGTK_P (XFRAME (Vterminal_frame)) |
| 5728 | || EQ (Fdaemonp (), Qt)) | 5712 | || IS_DAEMON) |
| 5729 | && CONSP (Vframe_list) | 5713 | && CONSP (Vframe_list) |
| 5730 | && !NILP (XCDR (Vframe_list))) ? Qt : Qnil); | 5714 | && !NILP (XCDR (Vframe_list))) ? Qt : Qnil); |
| 5731 | bufp->ie.kind = FOCUS_IN_EVENT; | 5715 | bufp->ie.kind = FOCUS_IN_EVENT; |
diff --git a/src/sysdep.c b/src/sysdep.c index 8895655566e..10269e4d0ce 100644 --- a/src/sysdep.c +++ b/src/sysdep.c | |||
| @@ -1341,8 +1341,7 @@ init_sys_modes (struct tty_display_info *tty_out) | |||
| 1341 | frame_garbaged = 1; | 1341 | frame_garbaged = 1; |
| 1342 | FOR_EACH_FRAME (tail, frame) | 1342 | FOR_EACH_FRAME (tail, frame) |
| 1343 | { | 1343 | { |
| 1344 | if ((FRAME_TERMCAP_P (XFRAME (frame)) | 1344 | if (is_tty_frame (XFRAME (frame)) |
| 1345 | || FRAME_MSDOS_P (XFRAME (frame))) | ||
| 1346 | && FRAME_TTY (XFRAME (frame)) == tty_out) | 1345 | && FRAME_TTY (XFRAME (frame)) == tty_out) |
| 1347 | FRAME_GARBAGED_P (XFRAME (frame)) = 1; | 1346 | FRAME_GARBAGED_P (XFRAME (frame)) = 1; |
| 1348 | } | 1347 | } |
diff --git a/src/term.c b/src/term.c index afc36be434e..15be02c6514 100644 --- a/src/term.c +++ b/src/term.c | |||
| @@ -2969,9 +2969,7 @@ Gpm-mouse can only be activated for one tty at a time. */) | |||
| 2969 | (void) | 2969 | (void) |
| 2970 | { | 2970 | { |
| 2971 | struct frame *f = SELECTED_FRAME (); | 2971 | struct frame *f = SELECTED_FRAME (); |
| 2972 | struct tty_display_info *tty | 2972 | struct tty_display_info *tty = FRAME_TERMCAP_P (f) ? FRAME_TTY (f) : NULL; |
| 2973 | = ((f)->output_method == output_termcap | ||
| 2974 | ? (f)->terminal->display_info.tty : NULL); | ||
| 2975 | Gpm_Connect connection; | 2973 | Gpm_Connect connection; |
| 2976 | 2974 | ||
| 2977 | if (!tty) | 2975 | if (!tty) |
| @@ -3017,9 +3015,7 @@ DEFUN ("gpm-mouse-stop", Fgpm_mouse_stop, Sgpm_mouse_stop, | |||
| 3017 | (void) | 3015 | (void) |
| 3018 | { | 3016 | { |
| 3019 | struct frame *f = SELECTED_FRAME (); | 3017 | struct frame *f = SELECTED_FRAME (); |
| 3020 | struct tty_display_info *tty | 3018 | struct tty_display_info *tty = FRAME_TERMCAP_P (f) ? FRAME_TTY (f) : NULL; |
| 3021 | = ((f)->output_method == output_termcap | ||
| 3022 | ? (f)->terminal->display_info.tty : NULL); | ||
| 3023 | 3019 | ||
| 3024 | if (!tty || gpm_tty != tty) | 3020 | if (!tty || gpm_tty != tty) |
| 3025 | return Qnil; /* Not activated on this terminal, nothing to do. */ | 3021 | return Qnil; /* Not activated on this terminal, nothing to do. */ |
| @@ -4214,7 +4210,7 @@ tty_free_frame_resources (struct frame *f) | |||
| 4214 | static void | 4210 | static void |
| 4215 | tty_free_frame_resources (struct frame *f) | 4211 | tty_free_frame_resources (struct frame *f) |
| 4216 | { | 4212 | { |
| 4217 | eassert (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)); | 4213 | eassert (is_tty_frame (f)); |
| 4218 | free_frame_faces (f); | 4214 | free_frame_faces (f); |
| 4219 | /* Deleting a child frame means we have to thoroughly redisplay its | 4215 | /* Deleting a child frame means we have to thoroughly redisplay its |
| 4220 | root frame to make sure the child disappears from the display. */ | 4216 | root frame to make sure the child disappears from the display. */ |
diff --git a/src/terminal.c b/src/terminal.c index 1b15d1f26be..5c4852c5b6f 100644 --- a/src/terminal.c +++ b/src/terminal.c | |||
| @@ -251,8 +251,8 @@ decode_live_terminal (Lisp_Object terminal) | |||
| 251 | return t; | 251 | return t; |
| 252 | } | 252 | } |
| 253 | 253 | ||
| 254 | /* Like decode_terminal, but ensure that the resulting terminal object refers | 254 | /* Like decode_live_terminal, but ensure that the resulting terminal |
| 255 | to a text-based terminal device. */ | 255 | object refers to a text-based terminal device. */ |
| 256 | 256 | ||
| 257 | struct terminal * | 257 | struct terminal * |
| 258 | decode_tty_terminal (Lisp_Object terminal) | 258 | decode_tty_terminal (Lisp_Object terminal) |
| @@ -508,6 +508,25 @@ return values. */) | |||
| 508 | } | 508 | } |
| 509 | } | 509 | } |
| 510 | 510 | ||
| 511 | DEFUN ("frame-initial-p", Fframe_initial_p, Sframe_initial_p, 0, 1, 0, | ||
| 512 | doc: /* Return non-nil if FRAME is the initial frame. | ||
| 513 | That is, the initial text frame used internally during daemon mode, | ||
| 514 | batch mode, and the early stages of startup. | ||
| 515 | If FRAME is a terminal object, return non-nil if it holds | ||
| 516 | the initial frame. FRAME defaults to the selected frame. */) | ||
| 517 | (Lisp_Object frame) | ||
| 518 | { | ||
| 519 | if (NILP (frame)) | ||
| 520 | frame = selected_frame; | ||
| 521 | if (FRAMEP (frame)) | ||
| 522 | { | ||
| 523 | struct frame *f = XFRAME (frame); | ||
| 524 | return FRAME_LIVE_P (f) && FRAME_INITIAL_P (f) ? Qt : Qnil; | ||
| 525 | } | ||
| 526 | struct terminal *t = decode_terminal (frame); | ||
| 527 | return t && t->type == output_initial ? Qt : Qnil; | ||
| 528 | } | ||
| 529 | |||
| 511 | DEFUN ("terminal-list", Fterminal_list, Sterminal_list, 0, 0, 0, | 530 | DEFUN ("terminal-list", Fterminal_list, Sterminal_list, 0, 0, 0, |
| 512 | doc: /* Return a list of all terminal devices. */) | 531 | doc: /* Return a list of all terminal devices. */) |
| 513 | (void) | 532 | (void) |
| @@ -680,8 +699,6 @@ init_initial_terminal (void) | |||
| 680 | #else | 699 | #else |
| 681 | initial_terminal_lisp = make_lisp_ptr (create_terminal (output_initial, NULL), Lisp_Vectorlike); | 700 | initial_terminal_lisp = make_lisp_ptr (create_terminal (output_initial, NULL), Lisp_Vectorlike); |
| 682 | #endif | 701 | #endif |
| 683 | /* Note: menu-bar.el:menu-bar-update-buffers knows about this | ||
| 684 | special name of the initial terminal. */ | ||
| 685 | initial_terminal->name = xstrdup ("initial_terminal"); | 702 | initial_terminal->name = xstrdup ("initial_terminal"); |
| 686 | initial_terminal->kboard = initial_kboard; | 703 | initial_terminal->kboard = initial_kboard; |
| 687 | initial_terminal->delete_terminal_hook = &delete_initial_terminal; | 704 | initial_terminal->delete_terminal_hook = &delete_initial_terminal; |
| @@ -725,6 +742,7 @@ or some time later. */); | |||
| 725 | Vdelete_terminal_functions = Qnil; | 742 | Vdelete_terminal_functions = Qnil; |
| 726 | 743 | ||
| 727 | DEFSYM (Qterminal_live_p, "terminal-live-p"); | 744 | DEFSYM (Qterminal_live_p, "terminal-live-p"); |
| 745 | DEFSYM (Qframe_initial_p, "frame-initial-p"); | ||
| 728 | DEFSYM (Qdelete_terminal_functions, "delete-terminal-functions"); | 746 | DEFSYM (Qdelete_terminal_functions, "delete-terminal-functions"); |
| 729 | DEFSYM (Qrun_hook_with_args, "run-hook-with-args"); | 747 | DEFSYM (Qrun_hook_with_args, "run-hook-with-args"); |
| 730 | 748 | ||
| @@ -734,6 +752,7 @@ or some time later. */); | |||
| 734 | defsubr (&Sdelete_terminal); | 752 | defsubr (&Sdelete_terminal); |
| 735 | defsubr (&Sframe_terminal); | 753 | defsubr (&Sframe_terminal); |
| 736 | defsubr (&Sterminal_live_p); | 754 | defsubr (&Sterminal_live_p); |
| 755 | defsubr (&Sframe_initial_p); | ||
| 737 | defsubr (&Sterminal_list); | 756 | defsubr (&Sterminal_list); |
| 738 | defsubr (&Sterminal_name); | 757 | defsubr (&Sterminal_name); |
| 739 | defsubr (&Sterminal_parameters); | 758 | defsubr (&Sterminal_parameters); |
diff --git a/src/w32xfns.c b/src/w32xfns.c index f920e407343..df3d42c9d28 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c | |||
| @@ -177,7 +177,7 @@ get_frame_dc (struct frame *f) | |||
| 177 | HGDIOBJ obj; | 177 | HGDIOBJ obj; |
| 178 | struct w32_output *output; | 178 | struct w32_output *output; |
| 179 | 179 | ||
| 180 | if (f->output_method != output_w32) | 180 | if (!FRAME_W32_P (f)) |
| 181 | emacs_abort (); | 181 | emacs_abort (); |
| 182 | 182 | ||
| 183 | enter_crit (); | 183 | enter_crit (); |
diff --git a/src/xdisp.c b/src/xdisp.c index fd2ce49e031..3251750cd2a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -13665,7 +13665,7 @@ clear_garbaged_frames (void) | |||
| 13665 | selected frame, and might leave the selected | 13665 | selected frame, and might leave the selected |
| 13666 | frame with corrupted display, if it happens not | 13666 | frame with corrupted display, if it happens not |
| 13667 | to be marked garbaged. */ | 13667 | to be marked garbaged. */ |
| 13668 | && !(f != sf && (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)))) | 13668 | && !(f != sf && is_tty_frame (f))) |
| 13669 | redraw_frame (f); | 13669 | redraw_frame (f); |
| 13670 | else | 13670 | else |
| 13671 | clear_current_matrices (f); | 13671 | clear_current_matrices (f); |
| @@ -16653,11 +16653,8 @@ hscroll_window_tree (Lisp_Object window) | |||
| 16653 | } | 16653 | } |
| 16654 | } | 16654 | } |
| 16655 | if (cursor_row->truncated_on_left_p) | 16655 | if (cursor_row->truncated_on_left_p) |
| 16656 | { | 16656 | /* On TTY frames, don't count the left truncation glyph. */ |
| 16657 | /* On TTY frames, don't count the left truncation glyph. */ | 16657 | x_offset -= is_tty_frame (XFRAME (WINDOW_FRAME (w))); |
| 16658 | struct frame *f = XFRAME (WINDOW_FRAME (w)); | ||
| 16659 | x_offset -= (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)); | ||
| 16660 | } | ||
| 16661 | 16658 | ||
| 16662 | text_area_width = window_box_width (w, TEXT_AREA); | 16659 | text_area_width = window_box_width (w, TEXT_AREA); |
| 16663 | 16660 | ||
| @@ -17391,7 +17388,7 @@ redisplay_internal (void) | |||
| 17391 | windows_or_buffers_changed = 47; | 17388 | windows_or_buffers_changed = 47; |
| 17392 | 17389 | ||
| 17393 | struct frame *previous_frame; | 17390 | struct frame *previous_frame; |
| 17394 | if ((FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)) | 17391 | if (is_tty_frame (sf) |
| 17395 | && (previous_frame = FRAME_TTY (sf)->previous_frame, | 17392 | && (previous_frame = FRAME_TTY (sf)->previous_frame, |
| 17396 | previous_frame != sf)) | 17393 | previous_frame != sf)) |
| 17397 | { | 17394 | { |
| @@ -17836,8 +17833,7 @@ redisplay_internal (void) | |||
| 17836 | } | 17833 | } |
| 17837 | 17834 | ||
| 17838 | retry_frame: | 17835 | retry_frame: |
| 17839 | if (FRAME_WINDOW_P (f) | 17836 | if (FRAME_WINDOW_P (f) || is_tty_frame (f) || f == sf) |
| 17840 | || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f) || f == sf) | ||
| 17841 | { | 17837 | { |
| 17842 | /* Only GC scrollbars when we redisplay the whole frame. */ | 17838 | /* Only GC scrollbars when we redisplay the whole frame. */ |
| 17843 | bool gcscrollbars = f->redisplay || !REDISPLAY_SOME_P (); | 17839 | bool gcscrollbars = f->redisplay || !REDISPLAY_SOME_P (); |
| @@ -32864,6 +32860,8 @@ produce_special_glyphs (struct it *it, enum display_element_type what, | |||
| 32864 | /* Mirror for R2L. */ | 32860 | /* Mirror for R2L. */ |
| 32865 | if (direction == R2L) | 32861 | if (direction == R2L) |
| 32866 | { | 32862 | { |
| 32863 | face_id = GLYPH_CODE_FACE (gc); | ||
| 32864 | |||
| 32867 | /* Try bidi mirroring first. */ | 32865 | /* Try bidi mirroring first. */ |
| 32868 | int c = bidi_mirror_char (GLYPH_CODE_CHAR (gc)); | 32866 | int c = bidi_mirror_char (GLYPH_CODE_CHAR (gc)); |
| 32869 | 32867 | ||
| @@ -32877,16 +32875,23 @@ produce_special_glyphs (struct it *it, enum display_element_type what, | |||
| 32877 | { | 32875 | { |
| 32878 | c = XFIXNUM (val); | 32876 | c = XFIXNUM (val); |
| 32879 | 32877 | ||
| 32880 | /* If something goes wrong defaults to '/'. */ | 32878 | /* If something goes wrong, fall back to '/'. */ |
| 32881 | if (CHAR_VALID_P (c)) | 32879 | if (CHAR_VALID_P (c)) |
| 32882 | SET_GLYPH (glyph, c, face_id); | 32880 | SET_GLYPH (glyph, c, face_id); |
| 32883 | else | 32881 | else |
| 32884 | SET_GLYPH (glyph, '/', face_id); | 32882 | SET_GLYPH (glyph, '/', face_id); |
| 32885 | } | 32883 | } |
| 32884 | else | ||
| 32885 | SET_GLYPH_FROM_GLYPH_CODE (glyph, gc); | ||
| 32886 | } | 32886 | } |
| 32887 | else | 32887 | else |
| 32888 | { | ||
| 32889 | struct face *face = FACE_FROM_ID (it->f, face_id); | ||
| 32890 | int id = FACE_FOR_CHAR (it->f, face, c, -1, Qnil); | ||
| 32891 | |||
| 32888 | /* Bidi mirroring. */ | 32892 | /* Bidi mirroring. */ |
| 32889 | SET_GLYPH (glyph, c, face_id); | 32893 | SET_GLYPH (glyph, c, id); |
| 32894 | } | ||
| 32890 | } | 32895 | } |
| 32891 | else | 32896 | else |
| 32892 | /* No mirroring. */ | 32897 | /* No mirroring. */ |
| @@ -32925,6 +32930,8 @@ produce_special_glyphs (struct it *it, enum display_element_type what, | |||
| 32925 | if (((it->bidi_it.paragraph_dir == R2L) && !left_edge_p) || | 32930 | if (((it->bidi_it.paragraph_dir == R2L) && !left_edge_p) || |
| 32926 | ((it->bidi_it.paragraph_dir == L2R) && left_edge_p)) | 32931 | ((it->bidi_it.paragraph_dir == L2R) && left_edge_p)) |
| 32927 | { | 32932 | { |
| 32933 | face_id = GLYPH_CODE_FACE (gc); | ||
| 32934 | |||
| 32928 | /* Try bidi mirroring first. */ | 32935 | /* Try bidi mirroring first. */ |
| 32929 | int c = bidi_mirror_char (GLYPH_CODE_CHAR (gc)); | 32936 | int c = bidi_mirror_char (GLYPH_CODE_CHAR (gc)); |
| 32930 | 32937 | ||
| @@ -32938,12 +32945,14 @@ produce_special_glyphs (struct it *it, enum display_element_type what, | |||
| 32938 | { | 32945 | { |
| 32939 | c = XFIXNUM (val); | 32946 | c = XFIXNUM (val); |
| 32940 | 32947 | ||
| 32941 | /* If something goes wrong defaults to '$'. */ | 32948 | /* If something goes wrong, fall back to '$'. */ |
| 32942 | if (CHAR_VALID_P (c)) | 32949 | if (CHAR_VALID_P (c)) |
| 32943 | SET_GLYPH (glyph, c, face_id); | 32950 | SET_GLYPH (glyph, c, face_id); |
| 32944 | else | 32951 | else |
| 32945 | SET_GLYPH (glyph, '$', face_id); | 32952 | SET_GLYPH (glyph, '$', face_id); |
| 32946 | } | 32953 | } |
| 32954 | else | ||
| 32955 | SET_GLYPH_FROM_GLYPH_CODE (glyph, gc); | ||
| 32947 | } | 32956 | } |
| 32948 | else | 32957 | else |
| 32949 | { | 32958 | { |
diff --git a/src/xfaces.c b/src/xfaces.c index 567a56d229c..fdc08391fb7 100644 --- a/src/xfaces.c +++ b/src/xfaces.c | |||
| @@ -5827,7 +5827,7 @@ face for italic. */) | |||
| 5827 | } | 5827 | } |
| 5828 | 5828 | ||
| 5829 | /* Dispatch to the appropriate handler. */ | 5829 | /* Dispatch to the appropriate handler. */ |
| 5830 | if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) | 5830 | if (is_tty_frame (f)) |
| 5831 | supports = tty_supports_face_attributes_p (f, attrs, def_face); | 5831 | supports = tty_supports_face_attributes_p (f, attrs, def_face); |
| 5832 | #ifdef HAVE_WINDOW_SYSTEM | 5832 | #ifdef HAVE_WINDOW_SYSTEM |
| 5833 | else | 5833 | else |
| @@ -6121,7 +6121,7 @@ realize_default_face (struct frame *f) | |||
| 6121 | ASET (lface, LFACE_FOREGROUND_INDEX, XCDR (color)); | 6121 | ASET (lface, LFACE_FOREGROUND_INDEX, XCDR (color)); |
| 6122 | else if (FRAME_WINDOW_P (f)) | 6122 | else if (FRAME_WINDOW_P (f)) |
| 6123 | return false; | 6123 | return false; |
| 6124 | else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) | 6124 | else if (FRAME_INITIAL_P (f) || is_tty_frame (f)) |
| 6125 | ASET (lface, LFACE_FOREGROUND_INDEX, build_string (unspecified_fg)); | 6125 | ASET (lface, LFACE_FOREGROUND_INDEX, build_string (unspecified_fg)); |
| 6126 | else | 6126 | else |
| 6127 | emacs_abort (); | 6127 | emacs_abort (); |
| @@ -6136,7 +6136,7 @@ realize_default_face (struct frame *f) | |||
| 6136 | ASET (lface, LFACE_BACKGROUND_INDEX, XCDR (color)); | 6136 | ASET (lface, LFACE_BACKGROUND_INDEX, XCDR (color)); |
| 6137 | else if (FRAME_WINDOW_P (f)) | 6137 | else if (FRAME_WINDOW_P (f)) |
| 6138 | return false; | 6138 | return false; |
| 6139 | else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) | 6139 | else if (FRAME_INITIAL_P (f) || is_tty_frame (f)) |
| 6140 | ASET (lface, LFACE_BACKGROUND_INDEX, build_string (unspecified_bg)); | 6140 | ASET (lface, LFACE_BACKGROUND_INDEX, build_string (unspecified_bg)); |
| 6141 | else | 6141 | else |
| 6142 | emacs_abort (); | 6142 | emacs_abort (); |
| @@ -6247,7 +6247,7 @@ realize_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE], | |||
| 6247 | 6247 | ||
| 6248 | if (FRAME_WINDOW_P (cache->f)) | 6248 | if (FRAME_WINDOW_P (cache->f)) |
| 6249 | face = realize_gui_face (cache, attrs); | 6249 | face = realize_gui_face (cache, attrs); |
| 6250 | else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f)) | 6250 | else if (is_tty_frame (cache->f)) |
| 6251 | face = realize_tty_face (cache, attrs); | 6251 | face = realize_tty_face (cache, attrs); |
| 6252 | else if (FRAME_INITIAL_P (cache->f)) | 6252 | else if (FRAME_INITIAL_P (cache->f)) |
| 6253 | { | 6253 | { |
| @@ -6760,7 +6760,7 @@ realize_tty_face (struct face_cache *cache, | |||
| 6760 | struct frame *f = cache->f; | 6760 | struct frame *f = cache->f; |
| 6761 | 6761 | ||
| 6762 | /* Frame must be a termcap frame. */ | 6762 | /* Frame must be a termcap frame. */ |
| 6763 | eassert (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f)); | 6763 | eassert (is_tty_frame (cache->f)); |
| 6764 | 6764 | ||
| 6765 | /* Allocate a new realized face. */ | 6765 | /* Allocate a new realized face. */ |
| 6766 | face = make_realized_face (attrs); | 6766 | face = make_realized_face (attrs); |
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 15fd9ed7007..2afd803240e 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el | |||
| @@ -91,7 +91,10 @@ This function is intended to be set to `auth-source-debug'." | |||
| 91 | ((symbol-function 'auth-source-pass-entries) (lambda () (mapcar #'car ,store)))) | 91 | ((symbol-function 'auth-source-pass-entries) (lambda () (mapcar #'car ,store)))) |
| 92 | (let ((auth-source-debug #'auth-source-pass--debug) | 92 | (let ((auth-source-debug #'auth-source-pass--debug) |
| 93 | (auth-source-pass--debug-log nil) | 93 | (auth-source-pass--debug-log nil) |
| 94 | (auth-source-pass--parse-log nil)) | 94 | (auth-source-pass--parse-log nil) |
| 95 | ;; Any existing directory will do, since we shouldn't do I/O | ||
| 96 | ;; except for the guard in `auth-source-pass-search'. | ||
| 97 | (auth-source-pass-filename default-directory)) | ||
| 95 | ,@body))) | 98 | ,@body))) |
| 96 | 99 | ||
| 97 | (defun auth-source-pass--explain-match-entry-p (entry hostname &optional user port) | 100 | (defun auth-source-pass--explain-match-entry-p (entry hostname &optional user port) |
diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index 67a377e9073..770a1549c56 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el | |||
| @@ -90,7 +90,7 @@ | |||
| 90 | (erase-buffer)) | 90 | (erase-buffer)) |
| 91 | (setopt cus-edit-test-foo1 :foo) | 91 | (setopt cus-edit-test-foo1 :foo) |
| 92 | (buffer-substring-no-properties (point-min) (point-max))))) | 92 | (buffer-substring-no-properties (point-min) (point-max))))) |
| 93 | (should (string-search "Value `:foo' for variable `cus-edit-test-foo1' does not match its type \"number\"" | 93 | (should (string-search "Value does not match cus-edit-test-foo1's type `number': :foo\n" |
| 94 | warn-txt)))) | 94 | warn-txt)))) |
| 95 | 95 | ||
| 96 | (defcustom cus-edit-test-bug63290-option nil | 96 | (defcustom cus-edit-test-bug63290-option nil |
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 7d0ea1692ff..77ed07fcc42 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el | |||
| @@ -658,5 +658,155 @@ The current directory at call time should not affect the result (Bug#50630)." | |||
| 658 | (let ((default-directory test-dir-other)) | 658 | (let ((default-directory test-dir-other)) |
| 659 | (files-tests--insert-directory-shows-given-free test-dir))))) | 659 | (files-tests--insert-directory-shows-given-free test-dir))))) |
| 660 | 660 | ||
| 661 | (ert-deftest dired-test-filename-with-newline-1 () ; bug#79528, bug#80499 | ||
| 662 | "Test handling of file name with literal embedded newline." | ||
| 663 | ;; File names with embedded newlines are not allowed on MS-Windows and | ||
| 664 | ;; MS-DOS. | ||
| 665 | (skip-when (memq system-type '(windows-nt ms-dos))) | ||
| 666 | (with-current-buffer "*Messages*" | ||
| 667 | (let ((inhibit-read-only t)) | ||
| 668 | (erase-buffer))) | ||
| 669 | (let* ((dired-auto-toggle-b-switch nil) | ||
| 670 | (dir (ert-resource-file | ||
| 671 | (file-name-as-directory "filename-with-newline"))) | ||
| 672 | (file (concat dir "filename\nwith newline")) | ||
| 673 | (buf (progn (make-empty-file file t) | ||
| 674 | (dired (file-name-directory file)))) | ||
| 675 | (warnbuf (get-buffer "*Warnings*"))) | ||
| 676 | (should (dired--filename-with-newline-p)) | ||
| 677 | (let ((beg (point)) ; beginning of file name | ||
| 678 | (_ (dired-move-to-end-of-filename))) | ||
| 679 | (should (search-backward "with newline")) ; literal space in file name | ||
| 680 | (should (search-backward "\n" beg))) ; literal newline in file name | ||
| 681 | (if noninteractive | ||
| 682 | (with-current-buffer "*Messages*" | ||
| 683 | (goto-char (point-min)) | ||
| 684 | (should (search-forward | ||
| 685 | "Warning (dired): Literal newline in file name."))) | ||
| 686 | (should (get-buffer-window warnbuf)) | ||
| 687 | (with-current-buffer warnbuf | ||
| 688 | (goto-char (point-min)) | ||
| 689 | (should (string-match | ||
| 690 | (regexp-quote "Warning (dired): Literal newline in file name.") | ||
| 691 | (buffer-substring (pos-bol) (pos-eol)))))) | ||
| 692 | (kill-buffer buf) | ||
| 693 | (kill-buffer warnbuf) | ||
| 694 | (delete-directory dir t))) | ||
| 695 | |||
| 696 | (ert-deftest dired-test-filename-with-newline-2 () ; bug#79528, bug#80499 | ||
| 697 | "Test handling of file name with embedded newline using `b' switch." | ||
| 698 | ;; File names with embedded newlines are not allowed on MS-Windows and | ||
| 699 | ;; MS-DOS. | ||
| 700 | (skip-when (memq system-type '(windows-nt ms-dos))) | ||
| 701 | (with-current-buffer "*Messages*" | ||
| 702 | (let ((inhibit-read-only t)) | ||
| 703 | (erase-buffer))) | ||
| 704 | (let* ((dired-auto-toggle-b-switch t) | ||
| 705 | (dir (ert-resource-file | ||
| 706 | (file-name-as-directory "filename-with-newline"))) | ||
| 707 | (file (concat dir "filename\nwith newline")) | ||
| 708 | (buf (progn (make-empty-file file t) | ||
| 709 | (dired-noselect (file-name-directory file)))) | ||
| 710 | (warnbuf (get-buffer "*Warnings*"))) | ||
| 711 | (with-current-buffer buf | ||
| 712 | (should (dired--filename-with-newline-p)) | ||
| 713 | (dired--toggle-b-switch) | ||
| 714 | (let ((beg (point)) ; beginning of file name | ||
| 715 | (_ (dired-move-to-end-of-filename))) | ||
| 716 | (should (search-backward "with\\ newline")) ; result of ls -b switch | ||
| 717 | (should (search-backward "\\n" beg)))) ; result of ls -b switch | ||
| 718 | (if noninteractive | ||
| 719 | (with-current-buffer "*Messages*" | ||
| 720 | (goto-char (point-min)) | ||
| 721 | (should-error (search-forward | ||
| 722 | "Warning (dired): Literal newline in file name."))) | ||
| 723 | (should-not (get-buffer "*Warnings*"))) | ||
| 724 | (kill-buffer buf) | ||
| 725 | (kill-buffer warnbuf) | ||
| 726 | (delete-directory dir t))) | ||
| 727 | |||
| 728 | (ert-deftest dired-test-ls-error-message () ; bug#80499 | ||
| 729 | "Test invoking `dired' on a nonexisting file. | ||
| 730 | A buffer should pop up containing the error emitted by ls. The buffer | ||
| 731 | visiting the nonexisting file should killed before `dired' returns, | ||
| 732 | hence another buffer should be returned." | ||
| 733 | (let* ((dir (ert-resource-file (file-name-as-directory "empty-dir"))) | ||
| 734 | (name (concat dir "bla")) | ||
| 735 | ;; Use PARENT = t in make-directory call to avoid failing if | ||
| 736 | ;; the directyory already exists for some reason. | ||
| 737 | (buf (progn (make-directory dir t) | ||
| 738 | (dired name)))) | ||
| 739 | ;; This is for MS-Windows and MS-DOS in the default configuration. | ||
| 740 | (when (and (featurep 'ls-lisp) | ||
| 741 | (boundp 'ls-lisp-use-insert-directory-program) | ||
| 742 | (null ls-lisp-use-insert-directory-program)) | ||
| 743 | (should (bufferp buf)) | ||
| 744 | (should (equal (buffer-name buf) (file-name-nondirectory name))) | ||
| 745 | (with-current-buffer buf | ||
| 746 | ;; 'ls-lisp' creates a Dired buffer of just 3 lines, with | ||
| 747 | ;; "(No match)" on the last line | ||
| 748 | (should (string-match "(No match)" (buffer-string))) | ||
| 749 | (should (= 3 (line-number-at-pos (buffer-size) t))))) | ||
| 750 | ;; This is for Posix systems and for MS-Windows/DOS when they use 'ls'. | ||
| 751 | (unless (and (featurep 'ls-lisp) | ||
| 752 | (boundp 'ls-lisp-use-insert-directory-program) | ||
| 753 | (null ls-lisp-use-insert-directory-program)) | ||
| 754 | (let ((errbuf (get-buffer "*ls error*"))) | ||
| 755 | (should (get-buffer-window errbuf)) | ||
| 756 | (should-not (equal (buffer-name buf) (file-name-nondirectory name))) | ||
| 757 | (with-current-buffer errbuf | ||
| 758 | (should (string-match-p | ||
| 759 | (format | ||
| 760 | ;; Use .* around file name to account for different | ||
| 761 | ;; file-name quoting styles, or no quoting at all. | ||
| 762 | "%s: cannot access .*%s.*: No such file or directory\n" | ||
| 763 | insert-directory-program (file-name-nondirectory name)) | ||
| 764 | (buffer-string)))) | ||
| 765 | (kill-buffer errbuf)) | ||
| 766 | (delete-directory dir t)))) | ||
| 767 | |||
| 768 | |||
| 769 | (defun dired-test--filename-with-backslash-n () | ||
| 770 | "Core of test `dired-test-filename-with-backslash-n'." | ||
| 771 | (let* ((dir (ert-resource-file | ||
| 772 | (file-name-as-directory "filename-with-backslash"))) | ||
| 773 | (file (concat dir "C:\\nppdf32log\\debuglog.txt")) | ||
| 774 | (buf (progn (make-empty-file file t) | ||
| 775 | (dired-noselect (file-name-directory file)))) | ||
| 776 | (warnbuf (get-buffer "*Warnings*"))) | ||
| 777 | (with-current-buffer buf | ||
| 778 | (should-not (dired--filename-with-newline-p)) | ||
| 779 | (dired--toggle-b-switch) | ||
| 780 | (should-not (dired--filename-with-newline-p)) | ||
| 781 | (let ((fn (car (directory-files dir t | ||
| 782 | directory-files-no-dot-files-regexp)))) | ||
| 783 | (should (equal fn file)))) | ||
| 784 | (if noninteractive | ||
| 785 | (with-current-buffer "*Messages*" | ||
| 786 | (goto-char (point-min)) | ||
| 787 | (should-error (search-forward | ||
| 788 | "Warning (dired): Literal newline in file name."))) | ||
| 789 | (should-not (get-buffer "*Warnings*"))) | ||
| 790 | (kill-buffer buf) | ||
| 791 | (kill-buffer warnbuf) | ||
| 792 | (delete-directory dir t))) | ||
| 793 | |||
| 794 | (ert-deftest dired-test-filename-with-backslash-n () ; bug#80608 | ||
| 795 | "Test file name containing literal backslash-n sequence. | ||
| 796 | Dired should not treat this sequence as a newline character, regardless | ||
| 797 | of the value of `dired-auto-toggle-b-switch'." | ||
| 798 | ;; File names with backslashes in basename are not allowed on MS systems. | ||
| 799 | (skip-when (memq system-type '(windows-nt ms-dos))) | ||
| 800 | (with-current-buffer "*Messages*" | ||
| 801 | (let ((inhibit-read-only t)) | ||
| 802 | (erase-buffer))) | ||
| 803 | (let ((dired-auto-toggle-b-switch nil)) | ||
| 804 | (dired-test--filename-with-backslash-n)) | ||
| 805 | (with-current-buffer "*Messages*" | ||
| 806 | (let ((inhibit-read-only t)) | ||
| 807 | (erase-buffer))) | ||
| 808 | (let ((dired-auto-toggle-b-switch nil)) | ||
| 809 | (dired-test--filename-with-backslash-n))) | ||
| 810 | |||
| 661 | (provide 'dired-tests) | 811 | (provide 'dired-tests) |
| 662 | ;;; dired-tests.el ends here | 812 | ;;; dired-tests.el ends here |
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el index da4a4d0fad7..cce28360eff 100644 --- a/test/lisp/erc/erc-track-tests.el +++ b/test/lisp/erc/erc-track-tests.el | |||
| @@ -478,12 +478,28 @@ | |||
| 478 | (funcall set-faces '(erc-notice-face)) | 478 | (funcall set-faces '(erc-notice-face)) |
| 479 | (erc-track-modified-channels) | 479 | (erc-track-modified-channels) |
| 480 | (should (equal (alist-get (current-buffer) erc-modified-channels-alist) | 480 | (should (equal (alist-get (current-buffer) erc-modified-channels-alist) |
| 481 | '(5 . erc-notice-face)))) | 481 | (if (gethash 'erc-notice-face erc-track--normal-faces) |
| 482 | '(5 . erc-notice-face) | ||
| 483 | '(5 erc-button-nick-default-face erc-nick-default-face))))) | ||
| 482 | 484 | ||
| 483 | (ert-deftest erc-track-modified-channels/baseline () | 485 | (ert-deftest erc-track-modified-channels/baseline () |
| 484 | (erc-tests-common-track-modified-channels | 486 | (erc-tests-common-track-modified-channels |
| 485 | #'erc-track-tests--modified-channels/baseline)) | 487 | #'erc-track-tests--modified-channels/baseline)) |
| 486 | 488 | ||
| 489 | ;; This "baseline" variant simulates `erc-notice-face' being absent from | ||
| 490 | ;; `erc-track-faces-normal-list' by removing it from the cached local | ||
| 491 | ;; copy in `erc-track--normal-faces'. When absent and a message | ||
| 492 | ;; highlighted in `erc-notice-face' is inserted, the mode line should | ||
| 493 | ;; not change if it's currently showing a face ranked higher in | ||
| 494 | ;; `erc-track-faces-priority-list'. ERC 5.6 and 5.6.1 featured a | ||
| 495 | ;; regression that caused the mode line to keep alternating regardless. | ||
| 496 | ;; See Bug#80659: erc: Faces not being updated correctly. | ||
| 497 | (ert-deftest erc-track-modified-channels/baseline/nonotice () | ||
| 498 | (erc-tests-common-track-modified-channels | ||
| 499 | (lambda (set-faces) | ||
| 500 | (remhash 'erc-notice-face erc-track--normal-faces) | ||
| 501 | (funcall #'erc-track-tests--modified-channels/baseline set-faces)))) | ||
| 502 | |||
| 487 | (ert-deftest erc-track-modified-channels/baseline/mention () | 503 | (ert-deftest erc-track-modified-channels/baseline/mention () |
| 488 | (erc-tests-common-track-modified-channels | 504 | (erc-tests-common-track-modified-channels |
| 489 | (lambda (set-faces) | 505 | (lambda (set-faces) |
| @@ -613,6 +629,15 @@ | |||
| 613 | (erc-tests-common-track-modified-channels | 629 | (erc-tests-common-track-modified-channels |
| 614 | #'erc-track-tests--modified-channels/baseline))) | 630 | #'erc-track-tests--modified-channels/baseline))) |
| 615 | 631 | ||
| 632 | ;; Option `erc-track-priority-faces-only' does not affect Bug#80659 (see | ||
| 633 | ;; baseline test without the option above). | ||
| 634 | (ert-deftest erc-track-modified-channels/priority-only-all/baseline/nonotice () | ||
| 635 | (let ((erc-track-priority-faces-only 'all)) | ||
| 636 | (erc-tests-common-track-modified-channels | ||
| 637 | (lambda (set-faces) | ||
| 638 | (remhash 'erc-notice-face erc-track--normal-faces) | ||
| 639 | (funcall #'erc-track-tests--modified-channels/baseline set-faces))))) | ||
| 640 | |||
| 616 | ;; This test simulates a common configuration that combines an | 641 | ;; This test simulates a common configuration that combines an |
| 617 | ;; `erc-track-faces-priority-list' removed of `erc-notice-face' with | 642 | ;; `erc-track-faces-priority-list' removed of `erc-notice-face' with |
| 618 | ;; `erc-track-priority-faces-only' being `all'. It also features in the | 643 | ;; `erc-track-priority-faces-only' being `all'. It also features in the |
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index e6b2a0eb078..6781c4a3d8b 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el | |||
| @@ -1027,7 +1027,23 @@ unquoted file names." | |||
| 1027 | (buffer-string))))) | 1027 | (buffer-string))))) |
| 1028 | (files-tests--with-temp-non-special-and-file-name-handler | 1028 | (files-tests--with-temp-non-special-and-file-name-handler |
| 1029 | (tmpdir nospecial-dir t) | 1029 | (tmpdir nospecial-dir t) |
| 1030 | (should-error (with-temp-buffer (insert-directory nospecial-dir ""))))) | 1030 | (if (memq system-type '(windows-nt ms-dos)) |
| 1031 | (should-error (with-temp-buffer (insert-directory nospecial-dir ""))) | ||
| 1032 | (with-temp-buffer (insert-directory nospecial-dir "")) | ||
| 1033 | (let ((errbuf (get-buffer "*ls error*")) | ||
| 1034 | ;; By the time `ls' is called in `insert-directory', the | ||
| 1035 | ;; handler prefix has been removed. | ||
| 1036 | (nospecial-dir (string-remove-prefix "/:" nospecial-dir))) | ||
| 1037 | (should errbuf) | ||
| 1038 | (with-current-buffer errbuf | ||
| 1039 | (should (string-match-p | ||
| 1040 | (format | ||
| 1041 | ;; Use .* around file name to account for different | ||
| 1042 | ;; file-name quoting styles, or no quoting at all. | ||
| 1043 | "%s: cannot access .*%s.*: No such file or directory\n" | ||
| 1044 | insert-directory-program nospecial-dir) | ||
| 1045 | (buffer-string)))) | ||
| 1046 | (kill-buffer errbuf))))) | ||
| 1031 | 1047 | ||
| 1032 | (ert-deftest files-tests-file-name-non-special-insert-file-contents () | 1048 | (ert-deftest files-tests-file-name-non-special-insert-file-contents () |
| 1033 | (files-tests--with-temp-non-special (tmpfile nospecial) | 1049 | (files-tests--with-temp-non-special (tmpfile nospecial) |
diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el index df9358b96c5..e668becd54d 100644 --- a/test/lisp/gnus/gnus-icalendar-tests.el +++ b/test/lisp/gnus/gnus-icalendar-tests.el | |||
| @@ -35,7 +35,7 @@ | |||
| 35 | (let (event) | 35 | (let (event) |
| 36 | (with-temp-buffer | 36 | (with-temp-buffer |
| 37 | (insert ical-string) | 37 | (insert ical-string) |
| 38 | (setq event (gnus-icalendar-event-from-buffer (buffer-name) participant))) | 38 | (setq event (gnus-icalendar-event-from-buffer (current-buffer) participant))) |
| 39 | event)) | 39 | event)) |
| 40 | 40 | ||
| 41 | (ert-deftest gnus-icalendar-parse () | 41 | (ert-deftest gnus-icalendar-parse () |
| @@ -94,7 +94,8 @@ END:VCALENDAR | |||
| 94 | (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") | 94 | (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") |
| 95 | (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) | 95 | (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) |
| 96 | (should (not (gnus-icalendar-event:recurring-p event))) | 96 | (should (not (gnus-icalendar-event:recurring-p event))) |
| 97 | (should (string= (gnus-icalendar-event:start event) "2020-12-08 15:00")) | 97 | (should (equal (gnus-icalendar-event:start event) |
| 98 | "2020-12-08 15:00")) | ||
| 98 | (with-slots (organizer summary description location end-time uid rsvp participation-type) event | 99 | (with-slots (organizer summary description location end-time uid rsvp participation-type) event |
| 99 | (should (string= organizer "anoncompany.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com")) | 100 | (should (string= organizer "anoncompany.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com")) |
| 100 | (should (string= summary "Townhall | All Company Meeting")) | 101 | (should (string= summary "Townhall | All Company Meeting")) |
| @@ -106,9 +107,20 @@ END:VCALENDAR | |||
| 106 | (should (eq participation-type 'non-participant)))) | 107 | (should (eq participation-type 'non-participant)))) |
| 107 | (setenv "TZ" tz)))) | 108 | (setenv "TZ" tz)))) |
| 108 | 109 | ||
| 110 | (defun gnus-icalendar-at/@ () | ||
| 111 | "Replace \" <at> \" with \"@\" before parsing." | ||
| 112 | (goto-char (point-min)) | ||
| 113 | (while (re-search-forward " <at> " nil t) | ||
| 114 | (replace-match "@"))) | ||
| 115 | |||
| 116 | ;; FIXME: is "icalendary" (not "icalendar") intentional, here and below? | ||
| 109 | (ert-deftest gnus-icalendary-byday () | 117 | (ert-deftest gnus-icalendary-byday () |
| 110 | "" | 118 | "" |
| 111 | (let ((tz (getenv "TZ")) | 119 | (let* ((tz (getenv "TZ")) |
| 120 | (icalendar-pre-parsing-hook | ||
| 121 | ;; clean up " <at> " addresses so the parser doesn't choke... | ||
| 122 | ;; FIXME: can we just change the test data, or is this a real example? | ||
| 123 | '(gnus-icalendar-at/@)) | ||
| 112 | (event (gnus-icalendar-tests--get-ical-event "\ | 124 | (event (gnus-icalendar-tests--get-ical-event "\ |
| 113 | BEGIN:VCALENDAR | 125 | BEGIN:VCALENDAR |
| 114 | PRODID:Zimbra-Calendar-Provider | 126 | PRODID:Zimbra-Calendar-Provider |
| @@ -138,8 +150,8 @@ SUMMARY:appointment every weekday\\, start jul 24\\, 2020\\, end aug 24\\, 2020 | |||
| 138 | ATTENDEE;CN=Mark Hershberger;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP | 150 | ATTENDEE;CN=Mark Hershberger;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP |
| 139 | =TRUE:mailto:hexmode <at> gmail.com | 151 | =TRUE:mailto:hexmode <at> gmail.com |
| 140 | ORGANIZER;CN=Mark A. Hershberger:mailto:mah <at> nichework.com | 152 | ORGANIZER;CN=Mark A. Hershberger:mailto:mah <at> nichework.com |
| 141 | DTSTART;TZID=\"America/New_York\":20200724T090000 | 153 | DTSTART;TZID=America/New_York:20200724T090000 |
| 142 | DTEND;TZID=\"America/New_York\":20200724T093000 | 154 | DTEND;TZID=America/New_York:20200724T093000 |
| 143 | STATUS:CONFIRMED | 155 | STATUS:CONFIRMED |
| 144 | CLASS:PUBLIC | 156 | CLASS:PUBLIC |
| 145 | X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY | 157 | X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY |
| @@ -163,10 +175,12 @@ END:VCALENDAR" (list "Mark Hershberger")))) | |||
| 163 | (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") | 175 | (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") |
| 164 | (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) | 176 | (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) |
| 165 | (should (gnus-icalendar-event:recurring-p event)) | 177 | (should (gnus-icalendar-event:recurring-p event)) |
| 166 | (should (string= (gnus-icalendar-event:recurring-interval event) "1")) | 178 | (should (= 1 (gnus-icalendar-event:recurring-interval event))) |
| 167 | (should (string= (gnus-icalendar-event:start event) "2020-07-24 15:00")) | 179 | (should (string= (gnus-icalendar-event:start event) "2020-07-24 15:00")) |
| 168 | (with-slots (organizer summary description location end-time uid rsvp participation-type) event | 180 | (with-slots (organizer summary description location end-time uid rsvp participation-type) event |
| 169 | (should (string= organizer "mah <at> nichework.com")) | 181 | (should (string= organizer |
| 182 | (replace-regexp-in-string " <at> " "@" | ||
| 183 | "mah <at> nichework.com"))) | ||
| 170 | (should (string= summary "appointment every weekday, start jul 24, 2020, end aug 24, 2020")) | 184 | (should (string= summary "appointment every weekday, start jul 24, 2020, end aug 24, 2020")) |
| 171 | (should (string= description "The following is a new meeting request:")) | 185 | (should (string= description "The following is a new meeting request:")) |
| 172 | (should (null location)) | 186 | (should (null location)) |
| @@ -236,7 +250,7 @@ END:VCALENDAR" (list "participant@anoncompany.com")))) | |||
| 236 | (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") | 250 | (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3") |
| 237 | (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) | 251 | (should (eq (eieio-object-class event) 'gnus-icalendar-event-request)) |
| 238 | (should (gnus-icalendar-event:recurring-p event)) | 252 | (should (gnus-icalendar-event:recurring-p event)) |
| 239 | (should (string= (gnus-icalendar-event:recurring-interval event) "1")) | 253 | (should (= 1 (gnus-icalendar-event:recurring-interval event))) |
| 240 | (should (string= (gnus-icalendar-event:start event) "2020-09-15 14:00")) | 254 | (should (string= (gnus-icalendar-event:start event) "2020-09-15 14:00")) |
| 241 | (with-slots (organizer summary description location end-time uid rsvp participation-type) event | 255 | (with-slots (organizer summary description location end-time uid rsvp participation-type) event |
| 242 | (should (string= organizer "anon@anoncompany.com")) | 256 | (should (string= organizer "anon@anoncompany.com")) |
| @@ -258,6 +272,29 @@ END:VCALENDAR" (list "participant@anoncompany.com")))) | |||
| 258 | (ert-deftest gnus-icalendar-accept-with-comment () | 272 | (ert-deftest gnus-icalendar-accept-with-comment () |
| 259 | "" | 273 | "" |
| 260 | (let ((event "\ | 274 | (let ((event "\ |
| 275 | BEGIN:VCALENDAR | ||
| 276 | PRODID:-//Google Inc//Google Calendar 70.9054//EN | ||
| 277 | VERSION:2.0 | ||
| 278 | CALSCALE:GREGORIAN | ||
| 279 | METHOD:REQUEST | ||
| 280 | BEGIN:VTIMEZONE | ||
| 281 | TZID:Europe/Berlin | ||
| 282 | X-LIC-LOCATION:Europe/Berlin | ||
| 283 | BEGIN:DAYLIGHT | ||
| 284 | TZOFFSETFROM:+0100 | ||
| 285 | TZOFFSETTO:+0200 | ||
| 286 | TZNAME:CEST | ||
| 287 | DTSTART:19700329T020000 | ||
| 288 | RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU | ||
| 289 | END:DAYLIGHT | ||
| 290 | BEGIN:STANDARD | ||
| 291 | TZOFFSETFROM:+0200 | ||
| 292 | TZOFFSETTO:+0100 | ||
| 293 | TZNAME:CET | ||
| 294 | DTSTART:19701025T030000 | ||
| 295 | RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU | ||
| 296 | END:STANDARD | ||
| 297 | END:VTIMEZONE | ||
| 261 | BEGIN:VEVENT | 298 | BEGIN:VEVENT |
| 262 | DTSTART;TZID=Europe/Berlin:20200915T140000 | 299 | DTSTART;TZID=Europe/Berlin:20200915T140000 |
| 263 | DTEND;TZID=Europe/Berlin:20200915T143000 | 300 | DTEND;TZID=Europe/Berlin:20200915T143000 |
| @@ -275,7 +312,8 @@ SEQUENCE:0 | |||
| 275 | STATUS:CONFIRMED | 312 | STATUS:CONFIRMED |
| 276 | SUMMARY:Casual coffee talk | 313 | SUMMARY:Casual coffee talk |
| 277 | TRANSP:OPAQUE | 314 | TRANSP:OPAQUE |
| 278 | END:VEVENT") | 315 | END:VEVENT |
| 316 | END:VCALENDAR") | ||
| 279 | (icalendar-identities '("participant@anoncompany.com"))) | 317 | (icalendar-identities '("participant@anoncompany.com"))) |
| 280 | (let* ((reply (with-temp-buffer | 318 | (let* ((reply (with-temp-buffer |
| 281 | (insert event) | 319 | (insert event) |
| @@ -292,6 +330,29 @@ END:VEVENT") | |||
| 292 | (ert-deftest gnus-icalendar-decline-without-changing-comment () | 330 | (ert-deftest gnus-icalendar-decline-without-changing-comment () |
| 293 | "" | 331 | "" |
| 294 | (let ((event "\ | 332 | (let ((event "\ |
| 333 | BEGIN:VCALENDAR | ||
| 334 | PRODID:-//Google Inc//Google Calendar 70.9054//EN | ||
| 335 | VERSION:2.0 | ||
| 336 | CALSCALE:GREGORIAN | ||
| 337 | METHOD:REQUEST | ||
| 338 | BEGIN:VTIMEZONE | ||
| 339 | TZID:Europe/Berlin | ||
| 340 | X-LIC-LOCATION:Europe/Berlin | ||
| 341 | BEGIN:DAYLIGHT | ||
| 342 | TZOFFSETFROM:+0100 | ||
| 343 | TZOFFSETTO:+0200 | ||
| 344 | TZNAME:CEST | ||
| 345 | DTSTART:19700329T020000 | ||
| 346 | RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU | ||
| 347 | END:DAYLIGHT | ||
| 348 | BEGIN:STANDARD | ||
| 349 | TZOFFSETFROM:+0200 | ||
| 350 | TZOFFSETTO:+0100 | ||
| 351 | TZNAME:CET | ||
| 352 | DTSTART:19701025T030000 | ||
| 353 | RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU | ||
| 354 | END:STANDARD | ||
| 355 | END:VTIMEZONE | ||
| 295 | BEGIN:VEVENT | 356 | BEGIN:VEVENT |
| 296 | DTSTART;TZID=Europe/Berlin:20200915T140000 | 357 | DTSTART;TZID=Europe/Berlin:20200915T140000 |
| 297 | DTEND;TZID=Europe/Berlin:20200915T143000 | 358 | DTEND;TZID=Europe/Berlin:20200915T143000 |
| @@ -310,7 +371,8 @@ SEQUENCE:0 | |||
| 310 | STATUS:CONFIRMED | 371 | STATUS:CONFIRMED |
| 311 | SUMMARY:Casual coffee talk | 372 | SUMMARY:Casual coffee talk |
| 312 | TRANSP:OPAQUE | 373 | TRANSP:OPAQUE |
| 313 | END:VEVENT") | 374 | END:VEVENT |
| 375 | END:VCALENDAR") | ||
| 314 | (icalendar-identities '("participant@anoncompany.com"))) | 376 | (icalendar-identities '("participant@anoncompany.com"))) |
| 315 | (let* ((reply (with-temp-buffer | 377 | (let* ((reply (with-temp-buffer |
| 316 | (insert event) | 378 | (insert event) |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 149fa1d2537..3972e5faa45 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -5078,6 +5078,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 5078 | (sort (file-name-all-completions "b" tmp-name) #'string-lessp) | 5078 | (sort (file-name-all-completions "b" tmp-name) #'string-lessp) |
| 5079 | '("bold" "boz/"))) | 5079 | '("bold" "boz/"))) |
| 5080 | (should-not (file-name-all-completions "a" tmp-name)) | 5080 | (should-not (file-name-all-completions "a" tmp-name)) |
| 5081 | ;; Symbolic links. | ||
| 5082 | (tramp--test-ignore-make-symbolic-link-error | ||
| 5083 | (make-symbolic-link | ||
| 5084 | (file-name-concat tmp-name "foo") | ||
| 5085 | (file-name-concat tmp-name "link1")) | ||
| 5086 | (should (file-exists-p (expand-file-name "link1" tmp-name))) | ||
| 5087 | (make-symbolic-link | ||
| 5088 | (file-name-concat tmp-name "boz") | ||
| 5089 | (file-name-concat tmp-name "link2")) | ||
| 5090 | (should (file-exists-p (expand-file-name "link2" tmp-name))) | ||
| 5091 | (should (equal (file-name-completion "li" tmp-name) "link")) | ||
| 5092 | (should (member "link1" (file-name-all-completions "" tmp-name))) | ||
| 5093 | (should (member "link2/" (file-name-all-completions "" tmp-name))) | ||
| 5094 | (delete-file (file-name-concat tmp-name "link1")) | ||
| 5095 | (delete-file (file-name-concat tmp-name "link2"))) | ||
| 5081 | ;; `completion-regexp-list' restricts the completion to | 5096 | ;; `completion-regexp-list' restricts the completion to |
| 5082 | ;; files which match all expressions in this list. | 5097 | ;; files which match all expressions in this list. |
| 5083 | ;; Ange-FTP does not complete "". | 5098 | ;; Ange-FTP does not complete "". |
| @@ -6329,9 +6344,12 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6329 | this-shell-command | 6344 | this-shell-command |
| 6330 | "echo foo >&2; echo bar" (current-buffer) stderr) | 6345 | "echo foo >&2; echo bar" (current-buffer) stderr) |
| 6331 | (should (string-equal "bar\n" (buffer-string))) | 6346 | (should (string-equal "bar\n" (buffer-string))) |
| 6332 | ;; Check stderr. | 6347 | ;; Check stderr. Some shells echo, for example the |
| 6348 | ;; "adb" or container methods. | ||
| 6333 | (should | 6349 | (should |
| 6334 | (string-equal "foo\n" (tramp-get-buffer-string stderr)))) | 6350 | (string-match-p |
| 6351 | (rx bol (** 1 2 "foo\n") eol) | ||
| 6352 | (tramp-get-buffer-string stderr)))) | ||
| 6335 | 6353 | ||
| 6336 | ;; Cleanup. | 6354 | ;; Cleanup. |
| 6337 | (ignore-errors (kill-buffer stderr)))))) | 6355 | (ignore-errors (kill-buffer stderr)))))) |
| @@ -6896,8 +6914,7 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6896 | "Check `vc-registered'." | 6914 | "Check `vc-registered'." |
| 6897 | :tags '(:expensive-test) | 6915 | :tags '(:expensive-test) |
| 6898 | (skip-unless (tramp--test-enabled)) | 6916 | (skip-unless (tramp--test-enabled)) |
| 6899 | (skip-unless (tramp--test-sh-p)) | 6917 | (skip-unless (tramp--test-supports-processes-p)) |
| 6900 | (skip-unless (not (tramp--test-crypt-p))) | ||
| 6901 | 6918 | ||
| 6902 | (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) | 6919 | (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) |
| 6903 | ;; We must use `file-truename' for the temporary directory, in | 6920 | ;; We must use `file-truename' for the temporary directory, in |
| @@ -6912,17 +6929,9 @@ INPUT, if non-nil, is a string sent to the process." | |||
| 6912 | (inhibit-message (not (ignore-errors (edebug-mode)))) | 6929 | (inhibit-message (not (ignore-errors (edebug-mode)))) |
| 6913 | (vc-handled-backends | 6930 | (vc-handled-backends |
| 6914 | (cond | 6931 | (cond |
| 6915 | ((tramp-find-executable | 6932 | ((executable-find vc-git-program 'remote) '(Git)) |
| 6916 | tramp-test-vec vc-git-program | 6933 | ((executable-find vc-hg-program 'remote) '(Hg)) |
| 6917 | (tramp-get-remote-path tramp-test-vec)) | 6934 | ((executable-find vc-bzr-program 'remote) |
| 6918 | '(Git)) | ||
| 6919 | ((tramp-find-executable | ||
| 6920 | tramp-test-vec vc-hg-program | ||
| 6921 | (tramp-get-remote-path tramp-test-vec)) | ||
| 6922 | '(Hg)) | ||
| 6923 | ((tramp-find-executable | ||
| 6924 | tramp-test-vec vc-bzr-program | ||
| 6925 | (tramp-get-remote-path tramp-test-vec)) | ||
| 6926 | (setq tramp-remote-process-environment | 6935 | (setq tramp-remote-process-environment |
| 6927 | (cons (format "BZR_HOME=%s" | 6936 | (cons (format "BZR_HOME=%s" |
| 6928 | (file-remote-p tmp-name1 'localname)) | 6937 | (file-remote-p tmp-name1 'localname)) |
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1c625d79ca2..4d9e468bee1 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el | |||
| @@ -8012,6 +8012,7 @@ always located at the beginning of buffer." | |||
| 8012 | def test():" | 8012 | def test():" |
| 8013 | 8013 | ||
| 8014 | (setopt treesit-font-lock-level 4) | 8014 | (setopt treesit-font-lock-level 4) |
| 8015 | (font-lock-ensure) | ||
| 8015 | (dolist (test '("pytest" "mark" "skip")) | 8016 | (dolist (test '("pytest" "mark" "skip")) |
| 8016 | (search-forward test) | 8017 | (search-forward test) |
| 8017 | (goto-char (match-beginning 0)) | 8018 | (goto-char (match-beginning 0)) |
| @@ -8022,6 +8023,7 @@ always located at the beginning of buffer." | |||
| 8022 | "all()" | 8023 | "all()" |
| 8023 | ;; enable 'function' feature from 4th level | 8024 | ;; enable 'function' feature from 4th level |
| 8024 | (setopt treesit-font-lock-level 4) | 8025 | (setopt treesit-font-lock-level 4) |
| 8026 | (font-lock-ensure) | ||
| 8025 | (should (eq (face-at-point) 'font-lock-builtin-face)))) | 8027 | (should (eq (face-at-point) 'font-lock-builtin-face)))) |
| 8026 | 8028 | ||
| 8027 | (ert-deftest python-ts-mode-interpolation-nested-string () | 8029 | (ert-deftest python-ts-mode-interpolation-nested-string () |
| @@ -8050,6 +8052,7 @@ always located at the beginning of buffer." | |||
| 8050 | "t = f\"beg {True + var}\"" | 8052 | "t = f\"beg {True + var}\"" |
| 8051 | 8053 | ||
| 8052 | (setopt treesit-font-lock-level 2) | 8054 | (setopt treesit-font-lock-level 2) |
| 8055 | (font-lock-ensure) | ||
| 8053 | (search-forward "f") | 8056 | (search-forward "f") |
| 8054 | (goto-char (match-beginning 0)) | 8057 | (goto-char (match-beginning 0)) |
| 8055 | (should (not (eq (face-at-point) 'font-lock-string-face))) | 8058 | (should (not (eq (face-at-point) 'font-lock-string-face))) |
| @@ -8068,6 +8071,7 @@ always located at the beginning of buffer." | |||
| 8068 | (setf (nth 2 treesit-font-lock-feature-list) | 8071 | (setf (nth 2 treesit-font-lock-feature-list) |
| 8069 | (remq 'string-interpolation (nth 2 treesit-font-lock-feature-list))) | 8072 | (remq 'string-interpolation (nth 2 treesit-font-lock-feature-list))) |
| 8070 | (setopt treesit-font-lock-level 3) | 8073 | (setopt treesit-font-lock-level 3) |
| 8074 | (font-lock-ensure) | ||
| 8071 | 8075 | ||
| 8072 | (search-forward "f") | 8076 | (search-forward "f") |
| 8073 | (goto-char (match-beginning 0)) | 8077 | (goto-char (match-beginning 0)) |
diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el index 73f7be3145d..c1afa197c64 100644 --- a/test/lisp/ses-tests.el +++ b/test/lisp/ses-tests.el | |||
| @@ -41,6 +41,19 @@ | |||
| 41 | (defvar B2) | 41 | (defvar B2) |
| 42 | (defvar ses--toto)) | 42 | (defvar ses--toto)) |
| 43 | 43 | ||
| 44 | ;; Check no border effects | ||
| 45 | ;; ====================================================================== | ||
| 46 | (defun ses-tests-check-no-border-effect () | ||
| 47 | (dolist (symb ses-localvars) | ||
| 48 | (when (consp symb) (setq symb (car symb))) | ||
| 49 | (when (string-match "\\`ses--" (symbol-name symb)) | ||
| 50 | (should (null (boundp symb)))))) | ||
| 51 | |||
| 52 | (defun ses-tests-unbind-local-vars () | ||
| 53 | (dolist (symb ses-localvars) | ||
| 54 | (when (consp symb) (setq symb (car symb))) | ||
| 55 | (when (string-match "\\`ses--" (symbol-name symb)) (makunbound symb)))) | ||
| 56 | |||
| 44 | ;; PLAIN FORMULA TESTS | 57 | ;; PLAIN FORMULA TESTS |
| 45 | ;; ====================================================================== | 58 | ;; ====================================================================== |
| 46 | 59 | ||
| @@ -48,24 +61,28 @@ | |||
| 48 | "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value | 61 | "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value |
| 49 | equal to 2. This is done with low level functions calls, not like | 62 | equal to 2. This is done with low level functions calls, not like |
| 50 | interactively." | 63 | interactively." |
| 64 | (ses-tests-unbind-local-vars) | ||
| 51 | (let ((ses-initial-size '(2 . 1))) | 65 | (let ((ses-initial-size '(2 . 1))) |
| 52 | (with-temp-buffer | 66 | (with-temp-buffer |
| 53 | (ses-mode) | 67 | (ses-mode) |
| 54 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) | 68 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) |
| 55 | (apply 'ses-cell-set-formula c) | 69 | (apply 'ses-cell-set-formula c) |
| 56 | (apply 'ses-calculate-cell (list (car c) (cadr c) nil))) | 70 | (apply 'ses-calculate-cell (list (car c) (cadr c) nil))) |
| 57 | (should (eq (bound-and-true-p A2) 2))))) | 71 | (should (eq (bound-and-true-p A2) 2)))) |
| 72 | (ses-tests-check-no-border-effect)) | ||
| 58 | 73 | ||
| 59 | (ert-deftest ses-tests-plain-formula () | 74 | (ert-deftest ses-tests-plain-formula () |
| 60 | "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value | 75 | "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value |
| 61 | equal to 2. This is done using interactive calls." | 76 | equal to 2. This is done using interactive calls." |
| 77 | (ses-tests-unbind-local-vars) | ||
| 62 | (let ((ses-initial-size '(2 . 1))) | 78 | (let ((ses-initial-size '(2 . 1))) |
| 63 | (with-temp-buffer | 79 | (with-temp-buffer |
| 64 | (ses-mode) | 80 | (ses-mode) |
| 65 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) | 81 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) |
| 66 | (apply 'funcall-interactively 'ses-edit-cell c)) | 82 | (apply 'funcall-interactively 'ses-edit-cell c)) |
| 67 | (ses-command-hook) | 83 | (ses-command-hook) |
| 68 | (should (eq (bound-and-true-p A2) 2))))) | 84 | (should (eq (bound-and-true-p A2) 2)))) |
| 85 | (ses-tests-check-no-border-effect)) | ||
| 69 | 86 | ||
| 70 | ;; PLAIN CELL RENAMING TESTS | 87 | ;; PLAIN CELL RENAMING TESTS |
| 71 | ;; ====================================================================== | 88 | ;; ====================================================================== |
| @@ -75,6 +92,7 @@ equal to 2. This is done using interactive calls." | |||
| 75 | This is done using low level functions, `ses-rename-cell' is not | 92 | This is done using low level functions, `ses-rename-cell' is not |
| 76 | called but instead we use text replacement in the buffer | 93 | called but instead we use text replacement in the buffer |
| 77 | previously passed in text mode." | 94 | previously passed in text mode." |
| 95 | (ses-tests-unbind-local-vars) | ||
| 78 | (let ((ses-initial-size '(2 . 1))) | 96 | (let ((ses-initial-size '(2 . 1))) |
| 79 | (with-temp-buffer | 97 | (with-temp-buffer |
| 80 | (ses-mode) | 98 | (ses-mode) |
| @@ -90,11 +108,13 @@ previously passed in text mode." | |||
| 90 | (should-not (local-variable-p 'A1)) | 108 | (should-not (local-variable-p 'A1)) |
| 91 | (should (eq ses--foo 1)) | 109 | (should (eq ses--foo 1)) |
| 92 | (should (equal (ses-cell-formula 1 0) '(ses-safe-formula (1+ ses--foo)))) | 110 | (should (equal (ses-cell-formula 1 0) '(ses-safe-formula (1+ ses--foo)))) |
| 93 | (should (eq (bound-and-true-p A2) 2))))) | 111 | (should (eq (bound-and-true-p A2) 2)))) |
| 112 | (ses-tests-check-no-border-effect)) | ||
| 94 | 113 | ||
| 95 | (ert-deftest ses-tests-renamed-cell () | 114 | (ert-deftest ses-tests-renamed-cell () |
| 96 | "Check that renaming A1 to `ses--foo' and setting `ses--foo' to 1 and A2 | 115 | "Check that renaming A1 to `ses--foo' and setting `ses--foo' to 1 and A2 |
| 97 | to (1+ ses--foo), makes A2 value equal to 2." | 116 | to (1+ ses--foo), makes A2 value equal to 2." |
| 117 | (ses-tests-unbind-local-vars) | ||
| 98 | (let ((ses-initial-size '(2 . 1))) | 118 | (let ((ses-initial-size '(2 . 1))) |
| 99 | (with-temp-buffer | 119 | (with-temp-buffer |
| 100 | (ses-mode) | 120 | (ses-mode) |
| @@ -105,11 +125,13 @@ to (1+ ses--foo), makes A2 value equal to 2." | |||
| 105 | (should-not (local-variable-p 'A1)) | 125 | (should-not (local-variable-p 'A1)) |
| 106 | (should (eq ses--foo 1)) | 126 | (should (eq ses--foo 1)) |
| 107 | (should (equal (ses-cell-formula 1 0) '(1+ ses--foo))) | 127 | (should (equal (ses-cell-formula 1 0) '(1+ ses--foo))) |
| 108 | (should (eq (bound-and-true-p A2) 2))))) | 128 | (should (eq (bound-and-true-p A2) 2)))) |
| 129 | (ses-tests-check-no-border-effect)) | ||
| 109 | 130 | ||
| 110 | (ert-deftest ses-tests-renamed-cell-after-setting () | 131 | (ert-deftest ses-tests-renamed-cell-after-setting () |
| 111 | "Check that setting A1 to 1 and A2 to (1+ A1), and then | 132 | "Check that setting A1 to 1 and A2 to (1+ A1), and then |
| 112 | renaming A1 to `ses--foo' makes `ses--foo' value equal to 2." | 133 | renaming A1 to `ses--foo' makes `ses--foo' value equal to 2." |
| 134 | (ses-tests-unbind-local-vars) | ||
| 113 | (let ((ses-initial-size '(2 . 1))) | 135 | (let ((ses-initial-size '(2 . 1))) |
| 114 | (with-temp-buffer | 136 | (with-temp-buffer |
| 115 | (ses-mode) | 137 | (ses-mode) |
| @@ -120,12 +142,14 @@ renaming A1 to `ses--foo' makes `ses--foo' value equal to 2." | |||
| 120 | (should-not (local-variable-p 'A1)) | 142 | (should-not (local-variable-p 'A1)) |
| 121 | (should (eq ses--foo 1)) | 143 | (should (eq ses--foo 1)) |
| 122 | (should (equal (ses-cell-formula 1 0) '(1+ ses--foo))) | 144 | (should (equal (ses-cell-formula 1 0) '(1+ ses--foo))) |
| 123 | (should (eq (bound-and-true-p A2) 2))))) | 145 | (should (eq (bound-and-true-p A2) 2)))) |
| 146 | (ses-tests-check-no-border-effect)) | ||
| 124 | 147 | ||
| 125 | (ert-deftest ses-tests-renaming-cell-with-one-symbol-formula () | 148 | (ert-deftest ses-tests-renaming-cell-with-one-symbol-formula () |
| 126 | "Check that setting A1 to 1 and A2 to A1, and then renaming A1 | 149 | "Check that setting A1 to 1 and A2 to A1, and then renaming A1 |
| 127 | to `ses--foo' makes `ses--foo' value equal to 1. Then set A1 to 2 and check | 150 | to `ses--foo' makes `ses--foo' value equal to 1. Then set A1 to 2 and check |
| 128 | that `ses--foo' becomes 2." | 151 | that `ses--foo' becomes 2." |
| 152 | (ses-tests-unbind-local-vars) | ||
| 129 | (let ((ses-initial-size '(3 . 1))) | 153 | (let ((ses-initial-size '(3 . 1))) |
| 130 | (with-temp-buffer | 154 | (with-temp-buffer |
| 131 | (ses-mode) | 155 | (ses-mode) |
| @@ -141,7 +165,8 @@ that `ses--foo' becomes 2." | |||
| 141 | (funcall-interactively 'ses-edit-cell 0 0 2) | 165 | (funcall-interactively 'ses-edit-cell 0 0 2) |
| 142 | (ses-command-hook); deferred recalc | 166 | (ses-command-hook); deferred recalc |
| 143 | (should (eq (bound-and-true-p A2) 2)) | 167 | (should (eq (bound-and-true-p A2) 2)) |
| 144 | (should (eq ses--foo 2))))) | 168 | (should (eq ses--foo 2)))) |
| 169 | (ses-tests-check-no-border-effect)) | ||
| 145 | 170 | ||
| 146 | 171 | ||
| 147 | ;; ROW INSERTION TESTS | 172 | ;; ROW INSERTION TESTS |
| @@ -151,6 +176,7 @@ that `ses--foo' becomes 2." | |||
| 151 | "Check that setting A1 to 1 and A2 to (1+ A1), and then jumping | 176 | "Check that setting A1 to 1 and A2 to (1+ A1), and then jumping |
| 152 | to A2 and inserting a row, makes A2 value empty, and A3 equal to | 177 | to A2 and inserting a row, makes A2 value empty, and A3 equal to |
| 153 | 2." | 178 | 2." |
| 179 | (ses-tests-unbind-local-vars) | ||
| 154 | (let ((ses-initial-size '(2 . 1))) | 180 | (let ((ses-initial-size '(2 . 1))) |
| 155 | (with-temp-buffer | 181 | (with-temp-buffer |
| 156 | (ses-mode) | 182 | (ses-mode) |
| @@ -161,13 +187,15 @@ to A2 and inserting a row, makes A2 value empty, and A3 equal to | |||
| 161 | (ses-insert-row 1) | 187 | (ses-insert-row 1) |
| 162 | (ses-command-hook) | 188 | (ses-command-hook) |
| 163 | (should-not (bound-and-true-p A2)) | 189 | (should-not (bound-and-true-p A2)) |
| 164 | (should (eq (bound-and-true-p A3) 2))))) | 190 | (should (eq (bound-and-true-p A3) 2)))) |
| 191 | (ses-tests-check-no-border-effect)) | ||
| 165 | 192 | ||
| 166 | 193 | ||
| 167 | (ert-deftest ses-tests-renamed-cells-row-insertion () | 194 | (ert-deftest ses-tests-renamed-cells-row-insertion () |
| 168 | "Check that setting A1 to 1 and A2 to (1+ A1), and then renaming A1 to `ses--foo' and A2 to `ses--bar' jumping | 195 | "Check that setting A1 to 1 and A2 to (1+ A1), and then renaming A1 to `ses--foo' and A2 to `ses--bar' jumping |
| 169 | to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to | 196 | to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to |
| 170 | 2." | 197 | 2." |
| 198 | (ses-tests-unbind-local-vars) | ||
| 171 | (let ((ses-initial-size '(2 . 1))) | 199 | (let ((ses-initial-size '(2 . 1))) |
| 172 | (with-temp-buffer | 200 | (with-temp-buffer |
| 173 | (ses-mode) | 201 | (ses-mode) |
| @@ -183,13 +211,15 @@ to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to | |||
| 183 | (ses-insert-row 1) | 211 | (ses-insert-row 1) |
| 184 | (ses-command-hook) | 212 | (ses-command-hook) |
| 185 | (should-not (bound-and-true-p A2)) | 213 | (should-not (bound-and-true-p A2)) |
| 186 | (should (eq ses--bar 2))))) | 214 | (should (eq ses--bar 2)))) |
| 215 | (ses-tests-check-no-border-effect)) | ||
| 187 | 216 | ||
| 188 | 217 | ||
| 189 | ;; JUMP tests | 218 | ;; JUMP tests |
| 190 | ;; ====================================================================== | 219 | ;; ====================================================================== |
| 191 | (ert-deftest ses-jump-B2-prefix-arg () | 220 | (ert-deftest ses-tests-jump-B2-prefix-arg () |
| 192 | "Test jumping to cell B2 by use of prefix argument" | 221 | "Test jumping to cell B2 by use of prefix argument" |
| 222 | (ses-tests-unbind-local-vars) | ||
| 193 | (let ((ses-initial-size '(3 . 3)) | 223 | (let ((ses-initial-size '(3 . 3)) |
| 194 | ses-after-entry-functions) | 224 | ses-after-entry-functions) |
| 195 | (with-temp-buffer | 225 | (with-temp-buffer |
| @@ -197,41 +227,49 @@ to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to | |||
| 197 | ;; C-u 4 M-x ses-jump | 227 | ;; C-u 4 M-x ses-jump |
| 198 | (let ((current-prefix-arg 4)) | 228 | (let ((current-prefix-arg 4)) |
| 199 | (call-interactively 'ses-jump)) | 229 | (call-interactively 'ses-jump)) |
| 200 | (should (eq (ses--cell-at-pos (point)) 'B2))))) | 230 | (should (eq (ses--cell-at-pos (point)) 'B2)))) |
| 231 | (ses-tests-check-no-border-effect)) | ||
| 201 | 232 | ||
| 202 | 233 | ||
| 203 | (ert-deftest ses-jump-B2-lowcase () | 234 | (ert-deftest ses-tests-jump-B2-lowcase () |
| 204 | "Test jumping to cell B2 by use of lowercase cell name string" | 235 | "Test jumping to cell B2 by use of lowercase cell name string" |
| 205 | (let ((ses-initial-size '(3 . 3)) | 236 | (ses-tests-unbind-local-vars) |
| 206 | ses-after-entry-functions) | 237 | (let ((ses-initial-size '(3 . 3)) |
| 207 | (with-temp-buffer | 238 | ses-after-entry-functions) |
| 208 | (ses-mode) | 239 | (with-temp-buffer |
| 209 | (funcall-interactively 'ses-jump "b2") | 240 | (ses-mode) |
| 210 | (ses-command-hook) | 241 | (funcall-interactively 'ses-jump "b2") |
| 211 | (should (eq (ses--cell-at-pos (point)) 'B2))))) | 242 | (ses-command-hook) |
| 212 | 243 | (should (eq (ses--cell-at-pos (point)) 'B2)))) | |
| 213 | (ert-deftest ses-jump-B2-lowcase-keys () | 244 | (ses-tests-check-no-border-effect)) |
| 245 | |||
| 246 | (ert-deftest ses-tests-jump-B2-lowcase-keys () | ||
| 214 | "Test jumping to cell B2 by use of lowercase cell name string with simulating keys" | 247 | "Test jumping to cell B2 by use of lowercase cell name string with simulating keys" |
| 215 | (let ((ses-initial-size '(3 . 3)) | 248 | (ses-tests-unbind-local-vars) |
| 216 | ses-after-entry-functions) | 249 | (let ((ses-initial-size '(3 . 3)) |
| 217 | (with-temp-buffer | 250 | ses-after-entry-functions) |
| 218 | (ses-mode) | 251 | (with-temp-buffer |
| 219 | (ert-simulate-keys [ ?b ?2 return] (ses-jump)) | 252 | (ses-mode) |
| 220 | (ses-command-hook) | 253 | (ert-simulate-keys [ ?b ?2 return] (ses-jump)) |
| 221 | (should (eq (ses--cell-at-pos (point)) 'B2))))) | 254 | (ses-command-hook) |
| 222 | 255 | (should (eq (ses--cell-at-pos (point)) 'B2)))) | |
| 223 | (ert-deftest ses-jump-B2-symbol () | 256 | (ses-tests-check-no-border-effect)) |
| 257 | |||
| 258 | (ert-deftest ses-tests-jump-B2-symbol () | ||
| 224 | "Test jumping to cell B2 by use of cell name symbol" | 259 | "Test jumping to cell B2 by use of cell name symbol" |
| 260 | (ses-tests-unbind-local-vars) | ||
| 225 | (let ((ses-initial-size '(3 . 3)) | 261 | (let ((ses-initial-size '(3 . 3)) |
| 226 | ses-after-entry-functions) | 262 | ses-after-entry-functions) |
| 227 | (with-temp-buffer | 263 | (with-temp-buffer |
| 228 | (ses-mode) | 264 | (ses-mode) |
| 229 | (funcall-interactively 'ses-jump 'B2) | 265 | (funcall-interactively 'ses-jump 'B2) |
| 230 | (ses-command-hook) | 266 | (ses-command-hook) |
| 231 | (should (eq (ses--cell-at-pos (point)) 'B2))))) | 267 | (should (eq (ses--cell-at-pos (point)) 'B2)))) |
| 268 | (ses-tests-check-no-border-effect)) | ||
| 232 | 269 | ||
| 233 | (ert-deftest ses-jump-B2-renamed () | 270 | (ert-deftest ses-tests-jump-B2-renamed () |
| 234 | "Test jumping to cell B2 after renaming it `ses--toto'." | 271 | "Test jumping to cell B2 after renaming it `ses--toto'." |
| 272 | (ses-tests-unbind-local-vars) | ||
| 235 | (let ((ses-initial-size '(3 . 3)) | 273 | (let ((ses-initial-size '(3 . 3)) |
| 236 | ses-after-entry-functions) | 274 | ses-after-entry-functions) |
| 237 | (with-temp-buffer | 275 | (with-temp-buffer |
| @@ -239,12 +277,14 @@ to `ses--bar' and inserting a row, makes A2 value empty, and `ses--bar' equal to | |||
| 239 | (ses-rename-cell 'ses--toto (ses-get-cell 1 1)) | 277 | (ses-rename-cell 'ses--toto (ses-get-cell 1 1)) |
| 240 | (ses-jump 'ses--toto) | 278 | (ses-jump 'ses--toto) |
| 241 | (ses-command-hook) | 279 | (ses-command-hook) |
| 242 | (should (eq (ses--cell-at-pos (point)) 'ses--toto))))) | 280 | (should (eq (ses--cell-at-pos (point)) 'ses--toto)))) |
| 281 | (ses-tests-check-no-border-effect)) | ||
| 243 | 282 | ||
| 244 | (ert-deftest ses-set-formula-write-cells-with-changed-references () | 283 | (ert-deftest ses-tests-set-formula-write-cells-with-changed-references () |
| 245 | "Test fix of bug#5852. | 284 | "Test fix of bug#5852. |
| 246 | When setting a formula has some cell with changed references, this | 285 | When setting a formula has some cell with changed references, this |
| 247 | cell has to be rewritten to data area." | 286 | cell has to be rewritten to data area." |
| 287 | (ses-tests-unbind-local-vars) | ||
| 248 | (let ((ses-initial-size '(4 . 3)) | 288 | (let ((ses-initial-size '(4 . 3)) |
| 249 | (ses-after-entry-functions nil)) | 289 | (ses-after-entry-functions nil)) |
| 250 | (with-temp-buffer | 290 | (with-temp-buffer |
| @@ -261,7 +301,8 @@ cell has to be rewritten to data area." | |||
| 261 | (ses-command-hook) | 301 | (ses-command-hook) |
| 262 | (should (equal (ses-cell-references 1 1) '(B3))) | 302 | (should (equal (ses-cell-references 1 1) '(B3))) |
| 263 | (ses-mode) | 303 | (ses-mode) |
| 264 | (should (equal (ses-cell-references 1 1) '(B3)))))) | 304 | (should (equal (ses-cell-references 1 1) '(B3))))) |
| 305 | (ses-tests-check-no-border-effect)) | ||
| 265 | 306 | ||
| 266 | (provide 'ses-tests) | 307 | (provide 'ses-tests) |
| 267 | 308 | ||
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 3d4f524d630..791b06f9edf 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el | |||
| @@ -1700,32 +1700,38 @@ final or penultimate step during initialization.")) | |||
| 1700 | (should (equal (funcall (subr--identity #'all) #'plusp ls) nil)) | 1700 | (should (equal (funcall (subr--identity #'all) #'plusp ls) nil)) |
| 1701 | (should (equal (funcall (subr--identity #'all) #'numberp ls) t)))) | 1701 | (should (equal (funcall (subr--identity #'all) #'numberp ls) t)))) |
| 1702 | 1702 | ||
| 1703 | (ert-deftest subr-any () | 1703 | (ert-deftest subr-member-if () |
| 1704 | (should (equal (any #'hash-table-p nil) nil)) | 1704 | (should (equal (member-if #'hash-table-p nil) nil)) |
| 1705 | (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3)))) | 1705 | (let ((ls (append '(3 2 1) '(0) '(-1 -2 -3)))) |
| 1706 | (should (equal (any #'numberp ls) ls)) | 1706 | (should (equal (member-if #'numberp ls) ls)) |
| 1707 | (should (equal (any (lambda (x) (numberp x)) ls) ls)) | 1707 | (should (equal (member-if (lambda (x) (numberp x)) ls) ls)) |
| 1708 | (should (equal (any #'plusp ls) ls)) | 1708 | (should (equal (member-if #'plusp ls) ls)) |
| 1709 | (should (equal (any #'zerop ls) '(0 -1 -2 -3))) | 1709 | (should (equal (member-if #'zerop ls) '(0 -1 -2 -3))) |
| 1710 | (should (equal (any #'bufferp ls) nil)) | 1710 | (should (equal (member-if #'bufferp ls) nil)) |
| 1711 | (let ((z 9)) | 1711 | (let ((z 9)) |
| 1712 | (should (equal (any (lambda (x) (< x z)) ls) ls)) | 1712 | (should (equal (member-if (lambda (x) (< x z)) ls) ls)) |
| 1713 | (should (equal (any (lambda (x) (< x (- z 9))) ls) '(-1 -2 -3))) | 1713 | (should (equal (member-if (lambda (x) (< x (- z 9))) ls) |
| 1714 | (should (equal (any (lambda (x) (> x z)) ls) nil))) | 1714 | '(-1 -2 -3))) |
| 1715 | (should (equal (funcall (subr--identity #'any) #'minusp ls) '(-1 -2 -3))) | 1715 | (should (equal (member-if (lambda (x) (> x z)) ls) nil))) |
| 1716 | (should (equal (funcall (subr--identity #'any) #'stringp ls) nil)))) | 1716 | (should (equal (funcall (subr--identity #'member-if) #'minusp ls) |
| 1717 | 1717 | '(-1 -2 -3))) | |
| 1718 | (defun subr-tests--any-memql (x xs) | 1718 | (should (equal (funcall (subr--identity #'member-if) #'stringp ls) nil)))) |
| 1719 | "Like `memql', but exercising the `compiler-macro' of `any'. | 1719 | |
| 1720 | (defun subr-tests--member-if-memql (x xs) | ||
| 1721 | "Like `memql', but exercising the `compiler-macro' of `member-if'. | ||
| 1720 | The argument names are important." | 1722 | The argument names are important." |
| 1721 | (any (lambda (y) (eql x y)) xs)) | 1723 | (member-if (lambda (y) (eql x y)) xs)) |
| 1722 | 1724 | ||
| 1723 | (ert-deftest subr-any-compiler-macro () | 1725 | (ert-deftest subr-member-if-compiler-macro () |
| 1724 | "Test `compiler-macro' of `any'." | 1726 | "Test `compiler-macro' of `member-if'." |
| 1725 | (let ((xs (number-sequence 0 4))) | 1727 | (let ((xs (number-sequence 0 4))) |
| 1726 | (dotimes (x (1+ (length xs))) | 1728 | (dotimes (x (1+ (length xs))) |
| 1727 | (should (eq (subr-tests--any-memql x xs) | 1729 | (should (eq (subr-tests--member-if-memql x xs) |
| 1728 | (memql x xs)))))) | 1730 | (memql x xs))))) |
| 1731 | (let ((n 0)) | ||
| 1732 | (member-if (prog1 (lambda (x) (eq x 5)) (incf n)) | ||
| 1733 | (number-sequence 0 4)) | ||
| 1734 | (should (eq n 1)))) | ||
| 1729 | 1735 | ||
| 1730 | (ert-deftest total-line-spacing () | 1736 | (ert-deftest total-line-spacing () |
| 1731 | (progn | 1737 | (progn |
diff --git a/test/lisp/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el index 26fe5002b68..b065fda5eed 100644 --- a/test/lisp/xt-mouse-tests.el +++ b/test/lisp/xt-mouse-tests.el | |||
| @@ -50,8 +50,7 @@ | |||
| 50 | ;; `xterm-mouse-mode' doesn't work in the initial | 50 | ;; `xterm-mouse-mode' doesn't work in the initial |
| 51 | ;; terminal. Since we can't create a second | 51 | ;; terminal. Since we can't create a second |
| 52 | ;; terminal in batch mode, fake it temporarily. | 52 | ;; terminal in batch mode, fake it temporarily. |
| 53 | (cl-letf (((symbol-function 'terminal-name) | 53 | (cl-letf (((symbol-function 'frame-initial-p) #'ignore)) |
| 54 | (lambda (&optional _terminal) "fake-terminal"))) | ||
| 55 | (xterm-mouse-mode 1)) | 54 | (xterm-mouse-mode 1)) |
| 56 | ,@body) | 55 | ,@body) |
| 57 | (xterm-mouse-mode 0)))) | 56 | (xterm-mouse-mode 0)))) |
diff --git a/test/src/terminal-tests.el b/test/src/terminal-tests.el new file mode 100644 index 00000000000..85c4fa04efc --- /dev/null +++ b/test/src/terminal-tests.el | |||
| @@ -0,0 +1,55 @@ | |||
| 1 | ;;; terminal-tests.el --- tests for terminal.c -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2026 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 of the License, or | ||
| 10 | ;; (at your option) 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 | ;;; Code: | ||
| 21 | |||
| 22 | (require 'ert) | ||
| 23 | |||
| 24 | (ert-deftest frame-initial-p () | ||
| 25 | "Test `frame-initial-p' behavior." | ||
| 26 | (should-not (frame-initial-p t)) | ||
| 27 | (should-not (frame-initial-p (current-buffer))) | ||
| 28 | (should-not (frame-initial-p (selected-window))) | ||
| 29 | ;; "Initial frame" implies "initial terminal", and | ||
| 30 | ;; no other terminal can have the initial frame. | ||
| 31 | (should-not (xor (equal (terminal-name) "initial_terminal") | ||
| 32 | (frame-initial-p))) | ||
| 33 | ;; Initial frame implies its terminal is a termcap-like | ||
| 34 | ;; text-mode terminal. | ||
| 35 | (should (or (not (frame-initial-p)) | ||
| 36 | (eq (terminal-live-p nil) t))) | ||
| 37 | ;; It similarly implies a termcap-like text-mode frame. | ||
| 38 | (should (or (not (frame-initial-p)) | ||
| 39 | (eq (frame-live-p (selected-frame)) t))) | ||
| 40 | (dolist (ft (append '(nil) (frame-list) (terminal-list))) | ||
| 41 | (ert-info ((prin1-to-string ft) :prefix "Argument: ") | ||
| 42 | (should-not (xor (equal (terminal-name ft) "initial_terminal") | ||
| 43 | (frame-initial-p ft))) | ||
| 44 | (should (or (not (frame-initial-p ft)) | ||
| 45 | (eq (terminal-live-p ft) t))))) | ||
| 46 | (cond (noninteractive | ||
| 47 | ;; Batch mode should have an initial frame. | ||
| 48 | (should (any #'frame-initial-p (frame-list))) | ||
| 49 | (should (any #'frame-initial-p (terminal-list)))) | ||
| 50 | ((not (daemonp)) | ||
| 51 | ;; Non-daemon interactive mode should have none. | ||
| 52 | (should-not (any #'frame-initial-p (frame-list))) | ||
| 53 | (should-not (any #'frame-initial-p (terminal-list)))))) | ||
| 54 | |||
| 55 | ;;; terminal-tests.el ends here | ||